sem_elim.ads (Check_For_Eliminated_Subprogram): New procedure for checking for…

sem_elim.ads (Check_For_Eliminated_Subprogram): New procedure for checking for references to eliminated subprograms that should...

2009-04-20  Gary Dismukes  <dismukes@adacore.com>

	* sem_elim.ads (Check_For_Eliminated_Subprogram): New procedure for
	checking for references to eliminated subprograms that should be
	flagged.
	(Eliminate_Error_Message): Update comment to say "references" rather
	than "calls" (since attribute cases are handled here as well).

	* sem_elim.adb (Check_For_Eliminated_Subprogram): New procedure for
	checking for references to eliminated subprograms that should be
	flagged.  Add with and use of Sem and Sem_Util.

	* sem_res.adb (Resolve_Call): Reject calls to eliminated subprograms.
	Add with and use of Sem_Elim.

	* sem_attr.adb (Analyze_Access_Attribute): Reject access attributes
	applied to eliminated subprograms.
	(Analyze_Attribute): Reject 'Address and 'Code_Address applied to
	eliminated subprograms.
	Add with and use of Sem_Elim.

	* sem_disp.adb (Check_Dispatching_Call): Remove error check for calls
	to eliminated subprograms, now handled during Resolve_Call.
	Remove with and use of Sem_Elim.

	* exp_disp.adb (Make_DT): Get Ultimate_Alias of primitive before
	testing Is_Eliminated, for proper handling of primitive derived from
	eliminated subprograms.

From-SVN: r146385

gcc/ada/exp_disp.adb

@@ -5160,22 +5160,19 @@ package body Exp_Disp is
                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))

gcc/ada/sem_attr.adb

@@ -51,6 +51,7 @@ with Sem_Cat;  use Sem_Cat;
 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;
@@ -573,6 +574,10 @@ package body Sem_Attr is
                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);
@@ -2076,6 +2081,11 @@ package body Sem_Attr is
                         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)
@@ -2516,6 +2526,11 @@ package body Sem_Attr is
          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));

gcc/ada/sem_disp.adb

@@ -44,7 +44,6 @@ with Sem;      use Sem;
 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;
@@ -486,10 +485,6 @@ package body Sem_Disp is
             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

gcc/ada/sem_elim.adb

@@ -28,7 +28,9 @@ with Einfo;    use Einfo;
 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;
@@ -662,6 +664,30 @@ package body Sem_Elim is
       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 --
    -------------------------

gcc/ada/sem_elim.ads

@@ -52,9 +52,17 @@ package Sem_Elim is
    --  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;

gcc/ada/sem_res.adb

@@ -60,6 +60,7 @@ with Sem_Ch8;  use Sem_Ch8;
 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;
@@ -5255,6 +5256,10 @@ package body Sem_Res is
          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);