mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-11 14:11:31 +08:00
2008-05-20 Ed Schonberg <schonberg@adacore.com>
Thomas Quinot <quinot@adacore.com> * sem_ch4.adb (Try_Indexed_Call): Handle properly a construct of the form F(S) where F is a parameterless function that returns an array, and S is a subtype mark. (Analyze_Call): Insert dereference when the prefix is a parameterless function that returns an access to subprogram and the call has parameters. Reject a non-overloaded call whose name resolves to denote a primitive operation of the stub type generated to support a remote access-to-class-wide type. From-SVN: r135640
This commit is contained in:
Ed Schonberg
Arnaud Charlet
parent
eede5a0d7a
commit
5ff2224569
@ -691,11 +691,14 @@ package body Sem_Ch4 is
|
||||
Success : Boolean := False;
|
||||
|
||||
function Name_Denotes_Function return Boolean;
|
||||
-- If the type of the name is an access to subprogram, this may be
|
||||
-- the type of a name, or the return type of the function being called.
|
||||
-- If the name is not an entity then it can denote a protected function.
|
||||
-- Until we distinguish Etype from Return_Type, we must use this
|
||||
-- routine to resolve the meaning of the name in the call.
|
||||
-- If the type of the name is an access to subprogram, this may be the
|
||||
-- type of a name, or the return type of the function being called. If
|
||||
-- the name is not an entity then it can denote a protected function.
|
||||
-- Until we distinguish Etype from Return_Type, we must use this routine
|
||||
-- to resolve the meaning of the name in the call.
|
||||
|
||||
procedure No_Interpretation;
|
||||
-- Output error message when no valid interpretation exists
|
||||
|
||||
---------------------------
|
||||
-- Name_Denotes_Function --
|
||||
@ -714,6 +717,43 @@ package body Sem_Ch4 is
|
||||
end if;
|
||||
end Name_Denotes_Function;
|
||||
|
||||
-----------------------
|
||||
-- No_Interpretation --
|
||||
-----------------------
|
||||
|
||||
procedure No_Interpretation is
|
||||
L : constant Boolean := Is_List_Member (N);
|
||||
K : constant Node_Kind := Nkind (Parent (N));
|
||||
|
||||
begin
|
||||
-- If the node is in a list whose parent is not an expression then it
|
||||
-- must be an attempted procedure call.
|
||||
|
||||
if L and then K not in N_Subexpr then
|
||||
if Ekind (Entity (Nam)) = E_Generic_Procedure then
|
||||
Error_Msg_NE
|
||||
("must instantiate generic procedure& before call",
|
||||
Nam, Entity (Nam));
|
||||
else
|
||||
Error_Msg_N
|
||||
("procedure or entry name expected", Nam);
|
||||
end if;
|
||||
|
||||
-- Check for tasking cases where only an entry call will do
|
||||
|
||||
elsif not L
|
||||
and then Nkind_In (K, N_Entry_Call_Alternative,
|
||||
N_Triggering_Alternative)
|
||||
then
|
||||
Error_Msg_N ("entry name expected", Nam);
|
||||
|
||||
-- Otherwise give general error message
|
||||
|
||||
else
|
||||
Error_Msg_N ("invalid prefix in call", Nam);
|
||||
end if;
|
||||
end No_Interpretation;
|
||||
|
||||
-- Start of processing for Analyze_Call
|
||||
|
||||
begin
|
||||
@ -734,13 +774,19 @@ package body Sem_Ch4 is
|
||||
-- name, or if it is a function name in the context of a procedure
|
||||
-- call. In this latter case, we have a call to a parameterless
|
||||
-- function that returns a pointer_to_procedure which is the entity
|
||||
-- being called.
|
||||
-- being called. Finally, F (X) may be a call to a parameterless
|
||||
-- function that returns a pointer to a function with parameters.
|
||||
|
||||
elsif Is_Access_Type (Etype (Nam))
|
||||
and then Ekind (Designated_Type (Etype (Nam))) = E_Subprogram_Type
|
||||
and then
|
||||
(not Name_Denotes_Function
|
||||
or else Nkind (N) = N_Procedure_Call_Statement)
|
||||
or else Nkind (N) = N_Procedure_Call_Statement
|
||||
or else
|
||||
(Nkind (Parent (N)) /= N_Explicit_Dereference
|
||||
and then Is_Entity_Name (Nam)
|
||||
and then No (First_Formal (Entity (Nam)))
|
||||
and then Present (Actuals)))
|
||||
then
|
||||
Nam_Ent := Designated_Type (Etype (Nam));
|
||||
Insert_Explicit_Dereference (Nam);
|
||||
@ -786,43 +832,19 @@ package body Sem_Ch4 is
|
||||
-- If no interpretations, give error message
|
||||
|
||||
if not Is_Overloadable (Nam_Ent) then
|
||||
declare
|
||||
L : constant Boolean := Is_List_Member (N);
|
||||
K : constant Node_Kind := Nkind (Parent (N));
|
||||
|
||||
begin
|
||||
-- If the node is in a list whose parent is not an
|
||||
-- expression then it must be an attempted procedure call.
|
||||
|
||||
if L and then K not in N_Subexpr then
|
||||
if Ekind (Entity (Nam)) = E_Generic_Procedure then
|
||||
Error_Msg_NE
|
||||
("must instantiate generic procedure& before call",
|
||||
Nam, Entity (Nam));
|
||||
else
|
||||
Error_Msg_N
|
||||
("procedure or entry name expected", Nam);
|
||||
end if;
|
||||
|
||||
-- Check for tasking cases where only an entry call will do
|
||||
|
||||
elsif not L
|
||||
and then Nkind_In (K, N_Entry_Call_Alternative,
|
||||
N_Triggering_Alternative)
|
||||
then
|
||||
Error_Msg_N ("entry name expected", Nam);
|
||||
|
||||
-- Otherwise give general error message
|
||||
|
||||
else
|
||||
Error_Msg_N ("invalid prefix in call", Nam);
|
||||
end if;
|
||||
|
||||
return;
|
||||
end;
|
||||
No_Interpretation;
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Operations generated for RACW stub types are called only through
|
||||
-- dispatching, and can never be the static interpretation of a call.
|
||||
|
||||
if Is_RACW_Stub_Type_Operation (Nam_Ent) then
|
||||
No_Interpretation;
|
||||
return;
|
||||
end if;
|
||||
|
||||
Analyze_One_Call (N, Nam_Ent, True, Success);
|
||||
|
||||
-- If this is an indirect call, the return type of the access_to
|
||||
@ -840,9 +862,9 @@ package body Sem_Ch4 is
|
||||
end if;
|
||||
|
||||
else
|
||||
-- An overloaded selected component must denote overloaded
|
||||
-- operations of a concurrent type. The interpretations are
|
||||
-- attached to the simple name of those operations.
|
||||
-- An overloaded selected component must denote overloaded operations
|
||||
-- of a concurrent type. The interpretations are attached to the
|
||||
-- simple name of those operations.
|
||||
|
||||
if Nkind (Nam) = N_Selected_Component then
|
||||
Nam := Selector_Name (Nam);
|
||||
@ -2223,6 +2245,16 @@ package body Sem_Ch4 is
|
||||
|
||||
end if;
|
||||
|
||||
-- If the call has been transformed into a slice, it is of the form
|
||||
-- F (Subtype) where F is paramterless. The node has ben rewritten in
|
||||
-- Try_Indexed_Call and there is nothing else to do.
|
||||
|
||||
if Is_Indexed
|
||||
and then Nkind (N) = N_Slice
|
||||
then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Normalize_Actuals (N, Nam, (Report and not Is_Indexed), Norm_OK);
|
||||
|
||||
if not Norm_OK then
|
||||
@ -5535,9 +5567,10 @@ package body Sem_Ch4 is
|
||||
Typ : Entity_Id;
|
||||
Skip_First : Boolean) return Boolean
|
||||
is
|
||||
Actuals : constant List_Id := Parameter_Associations (N);
|
||||
Actual : Node_Id;
|
||||
Index : Entity_Id;
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Actuals : constant List_Id := Parameter_Associations (N);
|
||||
Actual : Node_Id;
|
||||
Index : Entity_Id;
|
||||
|
||||
begin
|
||||
Actual := First (Actuals);
|
||||
@ -5559,7 +5592,21 @@ package body Sem_Ch4 is
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if not Has_Compatible_Type (Actual, Etype (Index)) then
|
||||
if Is_Entity_Name (Actual)
|
||||
and then Is_Type (Entity (Actual))
|
||||
and then No (Next (Actual))
|
||||
then
|
||||
Rewrite (N,
|
||||
Make_Slice (Loc,
|
||||
Prefix => Make_Function_Call (Loc,
|
||||
Name => Relocate_Node (Name (N))),
|
||||
Discrete_Range =>
|
||||
New_Occurrence_Of (Entity (Actual), Sloc (Actual))));
|
||||
|
||||
Analyze (N);
|
||||
return True;
|
||||
|
||||
elsif not Has_Compatible_Type (Actual, Etype (Index)) then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user