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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-21 Ed Schonberg <schonb...@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.--- gcc/ada/sem_ch4.adb
+++ 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);
--- /dev/null
new file mode 100644
+++ 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;
