[Ada] Improved handling of pragma Eliminate

[Ada] Improved handling of pragma Eliminate

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 352 bytes --]

This patch handles the new format generated by gnatelim for pragma Eliminate.

Tested on x86_64-pc-linux-gnu, committed on trunk

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_elim.adb (Check_Eliminated): Handle new improved eliminate
	information: no need for full scope check.
	(Eliminate_Error): Do not emit error in a generic context.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 4422 bytes --]

Index: sem_elim.adb
===================================================================
--- sem_elim.adb	(revision 146929)
+++ sem_elim.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2009, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -26,6 +26,7 @@
 with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
+with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Sem;      use Sem;
@@ -234,29 +235,6 @@
       Scop : Entity_Id;
       Form : Entity_Id;
 
-      function Original_Chars (S : Entity_Id) return Name_Id;
-      --  If the candidate subprogram is a protected operation of a single
-      --  protected object, the scope of the operation is the created
-      --  protected type, and we have to retrieve the original name of
-      --  the object.
-
-      --------------------
-      -- Original_Chars --
-      --------------------
-
-      function Original_Chars (S : Entity_Id) return Name_Id is
-      begin
-         if Ekind (S) /= E_Protected_Type
-           or else Comes_From_Source (S)
-         then
-            return Chars (S);
-         else
-            return Chars (Defining_Identifier (Original_Node (Parent (S))));
-         end if;
-      end Original_Chars;
-
-   --  Start of processing for Check_Eliminated
-
    begin
       if No_Elimination then
          return;
@@ -308,34 +286,10 @@
                goto Continue;
             end if;
 
-            --  Then we need to see if the static scope matches within the
-            --  compilation unit.
+            --  Find enclosing unit.
 
-            --  At the moment, gnatelim does not consider block statements as
-            --  scopes (even if a block is named)
+            Scop := Cunit_Entity (Current_Sem_Unit);
 
-            Scop := Scope (E);
-            while Ekind (Scop) = E_Block loop
-               Scop := Scope (Scop);
-            end loop;
-
-            if Elmt.Entity_Scope /= null then
-               for J in reverse Elmt.Entity_Scope'Range loop
-                  if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
-                     goto Continue;
-                  end if;
-
-                  Scop := Scope (Scop);
-                  while Ekind (Scop) = E_Block loop
-                     Scop := Scope (Scop);
-                  end loop;
-
-                  if not Is_Compilation_Unit (Scop) and then J = 1 then
-                     goto Continue;
-                  end if;
-               end loop;
-            end if;
-
             --  Now see if compilation unit matches
 
             for J in reverse Elmt.Unit_Name'Range loop
@@ -673,7 +627,10 @@
       Enclosing_Subp : Entity_Id;
 
    begin
-      if Is_Eliminated (Ultimate_Subp) and then not Inside_A_Generic then
+      if Is_Eliminated (Ultimate_Subp)
+        and then not Inside_A_Generic
+        and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit))
+      then
          Enclosing_Subp := Current_Subprogram;
          while Present (Enclosing_Subp) loop
             if Is_Eliminated (Enclosing_Subp) then
@@ -701,9 +658,21 @@
          end if;
       end loop;
 
-      --  Should never fall through, since entry should be in table
+      --  If this is an internal operation generated for a protected operation.
+      --  its name does not match the source name, so just report the error.
 
-      raise Program_Error;
+      if not Comes_From_Source (E)
+        and then Present (First_Entity (E))
+        and then Is_Concurrent_Record_Type (Etype (First_Entity (E)))
+      then
+         Error_Msg_NE
+           ("cannot reference eliminated protected subprogram", N, E);
+
+      --  Otherwise should not fall through, entry should be in table
+
+      else
+         raise Program_Error;
+      end if;
    end Eliminate_Error_Msg;
 
    ----------------