while Present (Prim_Elmt) loop
Prim := Node (Prim_Elmt);
+ -- Retrieve the ultimate alias of the primitive for proper
+ -- handling of renamings and eliminated primitives.
+
+ E := Ultimate_Alias (Prim);
+
if Is_Imported (Prim)
or else Present (Interface_Alias (Prim))
or else Is_Predefined_Dispatching_Operation (Prim)
- or else Is_Eliminated (Prim)
+ or else Is_Eliminated (E)
then
null;
else
- -- Traverse the list of aliased entities to handle
- -- renamings of predefined primitives.
-
- E := Prim;
- while Present (Alias (E)) loop
- E := Alias (E);
- end loop;
-
if not Is_Predefined_Dispatching_Operation (E)
and then not Is_Abstract_Subprogram (E)
and then not Present (Interface_Alias (E))
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch8; use Sem_Ch8;
with Sem_Dist; use Sem_Dist;
+with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
Error_Attr ("attribute% cannot be applied to a subprogram", P);
end if;
+ -- Issue an error if the prefix denotes an eliminated subprogram
+
+ Check_For_Eliminated_Subprogram (P, Entity (P));
+
-- Build the appropriate subprogram type
Build_Access_Subprogram_Type (P);
Error_Msg_N
("cannot take Address of intrinsic subprogram", N);
end if;
+
+ -- Issue an error if prefix denotes an eliminated subprogram
+
+ else
+ Check_For_Eliminated_Subprogram (P, Ent);
end if;
elsif Is_Object (Ent)
then
Error_Attr ("invalid prefix for % attribute", P);
Set_Address_Taken (Entity (P));
+
+ -- Issue an error if the prefix denotes an eliminated subprogram
+
+ else
+ Check_For_Eliminated_Subprogram (P, Entity (P));
end if;
Set_Etype (N, RTE (RE_Address));
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
with Sem_Ch6; use Sem_Ch6;
-with Sem_Elim; use Sem_Elim;
with Sem_Eval; use Sem_Eval;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
Set_Controlling_Argument (N, Control);
Check_Restriction (No_Dispatching_Calls, N);
- if Is_Eliminated (Ultimate_Alias (Subp_Entity)) then
- Eliminate_Error_Msg (N, Ultimate_Alias (Subp_Entity));
- end if;
-
-- If there is a statically tagged actual and a tag-indeterminate
-- call to a function of the ancestor (such as that provided by a
-- default), then treat this as a dispatching call and propagate
with Errout; use Errout;
with Namet; use Namet;
with Nlists; use Nlists;
+with Sem; use Sem;
with Sem_Prag; use Sem_Prag;
+with Sem_Util; use Sem_Util;
with Sinput; use Sinput;
with Sinfo; use Sinfo;
with Snames; use Snames;
return;
end Check_Eliminated;
+ -------------------------------------
+ -- Check_For_Eliminated_Subprogram --
+ -------------------------------------
+
+ procedure Check_For_Eliminated_Subprogram (N : Node_Id; S : Entity_Id) is
+ Ultimate_Subp : constant Entity_Id := Ultimate_Alias (S);
+ Enclosing_Subp : Entity_Id;
+
+ begin
+ if Is_Eliminated (Ultimate_Subp) and then not Inside_A_Generic then
+
+ Enclosing_Subp := Current_Subprogram;
+ while Present (Enclosing_Subp) loop
+ if Is_Eliminated (Enclosing_Subp) then
+ return;
+ end if;
+
+ Enclosing_Subp := Enclosing_Subprogram (Enclosing_Subp);
+ end loop;
+
+ Eliminate_Error_Msg (N, Ultimate_Subp);
+ end if;
+ end Check_For_Eliminated_Subprogram;
+
-------------------------
-- Eliminate_Error_Msg --
-------------------------
-- Checks if entity E is eliminated, and if so sets the Is_Eliminated
-- flag on the given entity.
+ procedure Check_For_Eliminated_Subprogram (N : Node_Id; S : Entity_Id);
+ -- Check that the subprogram S (or its ultimate parent in the case of a
+ -- derived subprogram or renaming) has not been eliminated. An error will
+ -- be flagged if the subprogram has been eliminated, unless the node N
+ -- occurs within an eliminated subprogram or within a generic unit. The
+ -- error will be posted on N.
+
procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id);
- -- Called by the front-end and back-end on encountering a call to an
- -- eliminated subprogram. N is the node for the call, and E is the
- -- entity of the subprogram being eliminated.
+ -- Called by the front-end and back-end on encountering a reference to an
+ -- eliminated subprogram. N is the node for the reference (such as occurs
+ -- in a call or attribute), and E is the entity of the subprogram that has
+ -- been eliminated.
end Sem_Elim;
with Sem_Ch13; use Sem_Ch13;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
+with Sem_Elim; use Sem_Elim;
with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval;
with Sem_Intr; use Sem_Intr;
Check_Potentially_Blocking_Operation (N);
end if;
+ -- Issue an error for a call to an eliminated subprogram
+
+ Check_For_Eliminated_Subprogram (Subp, Nam);
+
-- All done, evaluate call and deal with elaboration issues
Eval_Call (N);