[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 10661df9e5e752e14a1c4ef8dd51a0b62c9d2c10..ce5ef73b057bd52f3ab34653e45c3fe58673eab4 100644 (file)
--- 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 59e275ac52d7e0f32cd5c79fa201b260d6a85685..e1e826e54cec67f34d5bdfc7d120ffd222d2d62e 100644 (file)
--- 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 2ba0869ae2e4cec359fa643d7df8b7c92376c27d..44e581ea1491a6ae7e43fd5b353121a1156cdae9 100644 (file)
--- 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 (file)
index 0000000..47b1a13
--- /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;