From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 21 May 2018 14:51:35 +0000 (+0000)
Subject: [Ada] Spurious error on indexed call as prefix of a call
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=123906261b40f9084205961dcced31799c322083;p=gcc.git

[Ada] Spurious error on indexed call as prefix of a call

This patch refines the handling of the well-known syntactic ambiguity created
by a function with defaulted parameters that returns an array, so that F (X)
may designate a call to the function, or an indexing of a parameterless call.
This patch handles the case where such a call is itself the prefix of another
call, and the function is a primitive operation invoked in prefix form.

2018-05-21  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch4.adb (Analyze_One_Call): Recognize complex cases where an
	indexed call originally in prefix forn is itself the prefix of a
	further call.

gcc/testsuite/

	* gnat.dg/array30.adb: New testcase.

From-SVN: r260461
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 10661df9e5e..ce5ef73b057 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2018-05-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Analyze_One_Call): Recognize complex cases where an
+	indexed call originally in prefix forn is itself the prefix of a
+	further call.
+
 2018-04-04  Piotr Trojanek  <trojanek@adacore.com>
 
 	* sem_eval.adb (Is_Null_Range): Clarify access to the full view of a
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 59e275ac52d..e1e826e54ce 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3199,12 +3199,28 @@ package body Sem_Ch4 is
       Actuals : constant List_Id   := Parameter_Associations (N);
       Prev_T  : constant Entity_Id := Etype (N);
 
+      --  Recognize cases of prefixed calls that have been rewritten in
+      --  various ways. The simplest case is a rewritten selected component,
+      --  but it can also be an already-examined indexed component, or a
+      --  prefix that is itself a rewritten prefixed call that is in turn
+      --  an indexed call (the syntactic ambiguity involving the indexing of
+      --  a function with defaulted parameters that returns an array).
+      --  A flag Maybe_Indexed_Call might be useful here ???
+
       Must_Skip  : constant Boolean := Skip_First
                      or else Nkind (Original_Node (N)) = N_Selected_Component
                      or else
                        (Nkind (Original_Node (N)) = N_Indexed_Component
                           and then Nkind (Prefix (Original_Node (N)))
+                            = N_Selected_Component)
+                     or else
+                       (Nkind (Parent (N)) = N_Function_Call
+                          and then Is_Array_Type (Etype (Name (N)))
+                          and then Etype (Original_Node (N)) =
+                            Component_Type (Etype (Name (N)))
+                          and then Nkind (Original_Node (Parent (N)))
                             = N_Selected_Component);
+
       --  The first formal must be omitted from the match when trying to find
       --  a primitive operation that is a possible interpretation, and also
       --  after the call has been rewritten, because the corresponding actual
@@ -4352,6 +4368,10 @@ package body Sem_Ch4 is
       QE_Scop : Entity_Id;
 
    begin
+      --  The processing is similar to that for quantified expressions,
+      --  which have a similar structure and are eventually transformed
+      --  into a loop.
+
       QE_Scop := New_Internal_Entity (E_Loop, Current_Scope, Sloc (N), 'L');
       Set_Etype  (QE_Scop, Standard_Void_Type);
       Set_Scope  (QE_Scop, Current_Scope);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2ba0869ae2e..44e581ea149 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-04-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/array30.adb: New testcase.
+
 2018-04-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* gnat.dg/sync2.adb, gnat.dg/sync2.ads: New testcase.
diff --git a/gcc/testsuite/gnat.dg/array30.adb b/gcc/testsuite/gnat.dg/array30.adb
new file mode 100644
index 00000000000..47b1a132731
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array30.adb
@@ -0,0 +1,40 @@
+--  { dg-do run }
+
+with Ada.Text_IO;
+
+procedure Array30 is
+
+   package P is
+      type T is tagged record
+         value : Integer := 123;
+      end record;
+
+      type Ar is array (1..10) of T;
+      function F (Obj : T) return Ar;
+      function F2 (Obj : T) return T;
+   end P;
+   use P;
+
+   package body P is
+      function F (Obj : T) return Ar is
+      begin
+         return (others => <>);
+      end;
+
+      function F2 (Obj : T) return T is
+      begin
+         return (value => -111);
+      end F2;
+  end P;
+
+  Thing : T;
+begin
+  if Thing.F (4).Value /= 0 then
+     if Thing.F (5).Value /= 123 then
+        raise Program_Error;
+     end if;
+     if Thing.F (5).F2.Value /= -111 then
+        raise Program_Error;
+     end if;
+  end if;
+end;