This patch handles properly additional constructs of the form F.all (I), where
F is an access_to_function that can be called without parameters, and that
returns an array type.
Compiling err.adb must yield:
err.adb:23:09: too many arguments in call to "A"
err.adb:24:09: too many arguments in call
---
procedure Err is
function F return String is
begin
return "ABCD";
end F;
type Acc_F is access function return String;
function A return Acc_F Is
begin
return F'Access;
end A;
function AA (I : Integer) return Acc_F Is
begin
return F'Access;
end AA;
B : Integer := 1;
C : Character;
begin
C := A (B); -- (1) too many arguments in call
C := AA(1) (B); -- (3) too many arguments in call
end Err;
---
Executing essai.adb must yield:
'A'
'B'
'C'
---
with Text_IO; use Text_IO;
procedure Essai is
function F return String is
begin
return "ABCD";
end F;
type Acc_F is access function return String;
function A return Acc_F Is
begin
return F'Access;
end A;
function AA (I : Integer) return Acc_F Is
begin
return F'Access;
end AA;
B : Integer := 1;
C : Character;
begin
C := A.all (B);
Put_Line (Character'image (C)); B := B+1;
C := AA(1).all (B);
Put_Line (Character'image (C)); B := B+1;
C := F(B);
Put_Line (Character'image (C)); B := B+1;
end Essai;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-09-10 Ed Schonberg <[email protected]>
* sem_ch3.adb (Access_Subprogram_Declaration): Check whether the
designated type can appear in a parameterless call.
* sem_ch4.adb (Analyze_Call): Do not insert an explicit dereference
in the case of an indirect call through an access function that
returns an array type.
(Analyze_One_Call): Handle properly legal parameterless calls
whose result is indexed, in constructs of the for F.all (I)
* sem_ch6.ads (May_Need_Actuals): Make public, for use on access
to subprogram types.
* sem_res.adb (Resolve_Call): If the call is indirect, there is
no entity to set on the name in the call.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 202456)
+++ sem_ch3.adb (working copy)
@@ -1256,6 +1256,11 @@
end loop;
end if;
+ -- Check whether an indirect call without actuals may be possible. This
+ -- is used when resolving calls whose result is then indexed.
+
+ May_Need_Actuals (Desig_Type);
+
-- If the return type is incomplete, this is legal as long as the type
-- is declared in the current scope and will be completed in it (rather
-- than being part of limited view).
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 202459)
+++ sem_res.adb (working copy)
@@ -5460,8 +5460,14 @@
("cannot disambiguate function call and indexing", N);
else
New_Subp := Relocate_Node (Subp);
- Set_Entity (Subp, Nam);
+ -- The called entity may be an explicit dereference, in which
+ -- case there is no entity to set.
+
+ if Nkind (New_Subp) /= N_Explicit_Dereference then
+ Set_Entity (Subp, Nam);
+ end if;
+
if (Is_Array_Type (Ret_Type)
and then Component_Type (Ret_Type) /= Any_Type)
or else
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 202451)
+++ sem_ch4.adb (working copy)
@@ -1037,6 +1037,9 @@
-- function that returns a pointer_to_procedure which is the entity
-- being called. Finally, F (X) may be a call to a parameterless
-- function that returns a pointer to a function with parameters.
+ -- Note that if F return an access to subprogram whose designated
+ -- type is an array, F (X) cannot be interpreted as an indirect call
+ -- through the result of the call to F.
elsif Is_Access_Type (Etype (Nam))
and then Ekind (Designated_Type (Etype (Nam))) = E_Subprogram_Type
@@ -1047,6 +1050,8 @@
(Nkind (Parent (N)) /= N_Explicit_Dereference
and then Is_Entity_Name (Nam)
and then No (First_Formal (Entity (Nam)))
+ and then not
+ Is_Array_Type (Etype (Designated_Type (Etype (Nam))))
and then Present (Actuals)))
then
Nam_Ent := Designated_Type (Etype (Nam));
@@ -2998,7 +3003,9 @@
return;
end if;
- -- An indexing requires at least one actual
+ -- An indexing requires at least one actual.The name of the call cannot
+ -- be an implicit indirect call, so it cannot be a generated explicit
+ -- dereference.
if not Is_Empty_List (Actuals)
and then
@@ -3007,7 +3014,11 @@
(Needs_One_Actual (Nam)
and then Present (Next_Actual (First (Actuals)))))
then
- if Is_Array_Type (Subp_Type) then
+ if Is_Array_Type (Subp_Type)
+ and then
+ (Nkind (Name (N)) /= N_Explicit_Dereference
+ or else Comes_From_Source (Name (N)))
+ then
Is_Indexed := Try_Indexed_Call (N, Nam, Subp_Type, Must_Skip);
elsif Is_Access_Type (Subp_Type)
@@ -3046,9 +3057,14 @@
if not Norm_OK then
-- If an indirect call is a possible interpretation, indicate
- -- success to the caller.
+ -- success to the caller. This may be an indecing of an explicit
+ -- dereference of a call that returns an access type (see above).
- if Is_Indirect then
+ if Is_Indirect
+ or else (Is_Indexed
+ and then Nkind (Name (N)) = N_Explicit_Dereference
+ and then Comes_From_Source (Name (N)))
+ then
Success := True;
return;
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 202460)
+++ sem_ch6.adb (working copy)
@@ -211,10 +211,6 @@
-- Create the declaration for an inequality operator that is implicitly
-- created by a user-defined equality operator that yields a boolean.
- procedure May_Need_Actuals (Fun : Entity_Id);
- -- Flag functions that can be called without parameters, i.e. those that
- -- have no parameters, or those for which defaults exist for all parameters
-
procedure Process_PPCs
(N : Node_Id;
Spec_Id : Entity_Id;
Index: sem_ch6.ads
===================================================================
--- sem_ch6.ads (revision 202451)
+++ sem_ch6.ads (working copy)
@@ -234,6 +234,13 @@
-- E is the entity for a subprogram or generic subprogram spec. This call
-- lists all inherited Pre/Post aspects if List_Inherited_Pre_Post is True.
+ procedure May_Need_Actuals (Fun : Entity_Id);
+ -- Flag functions that can be called without parameters, i.e. those that
+ -- have no parameters, or those for which defaults exist for all parameters
+ -- Used for subprogram declarations and for access subprogram declarations,
+ -- where they apply to the anonymous designated type. On return the flag
+ -- Set_Needs_No_Actuals is set appropriately in Fun.
+
function Mode_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
-- Determine whether two callable entities (subprograms, entries,
-- literals) are mode conformant (RM 6.3.1(15))
