aspects.adb: Alphabetize subprogram bodies in this unit.

2013-04-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb: Alphabetize subprogram bodies in this unit. Add
	an entry for Aspect_Ghost in the table of canonical aspects.
	(Has_Aspect): New routine.
	* aspects.ads: Add Aspect_Ghost to all relevant
	tables. Alphabetize subprograms in this unit.
	(Has_Aspect): New routine.
	* einfo.adb: Add with and use clauses for Aspects.
	(Is_Ghost_Function): New routine.
	* einfo.ads: Add new synthesized attribute Is_Ghost_Function and
	update the structure of the related nodes.
	(Is_Ghost_Function): New routine.
	* exp_ch4.adb (Find_Enclosing_Context): Use routine
	Is_Body_Or_Package_Declaration to terminate a search.
	(Is_Body_Or_Unit): Removed.
	* exp_util.adb (Within_Case_Or_If_Expression): Use routine
	Is_Body_Or_Package_Declaration to terminate a search.
	* par-prag.adb: Add pragma Ghost to the list of pragmas that do
	not need special processing by the parser.
	* sem_attr.adb (Analyze_Access_Attribute): Detect an
	illegal use of 'Access where the prefix is a ghost function.
	(Analyze_Attribute): Use routine Is_Body_Or_Package_Declaration
	to terminate a search.	(Check_References_In_Prefix): Use routine
	Is_Body_Or_Package_Declaration to terminate a search.
	* sem_ch4.adb (Analyze_Call): Mark a function when it appears
	inside an assertion expression.  Verify the legality of a call
	to a ghost function.
	(Check_Ghost_Function_Call): New routine.
	* sem_ch6.adb (Analyze_Function_Call): Code reformatting. Move
	the setting of attribute In_Assertion_Expression to Analyze_Call.
	(Check_Overriding_Indicator): Detect an illegal attempt to
	override a function with a ghost function.
	* sem_ch12.adb (Preanalyze_Actuals): Detect an illegal use of
	a ghost function as a generic actual.
	* sem_elab.adb (Check_Internal_Call_Continue): Update the call
	to In_Assertion.
	* sem_prag.adb: Add an entry for pragma Ghost in the table
	of significant arguments.
	(Analyze_Pragma): Do not analyze
	an "others" case guard. Add processing for pragma Ghost. Use
	Preanalyze_Assert_Expression when analyzing the expression of
	pragmas Loop_Invariant and Loop_Variant.
	* sem_util.adb (Get_Subprogram_Entity): Reimplemented.
	(Is_Body_Or_Package_Declaration): New routine.
	* sem_util.ads: Alphabetize subprotrams in this unit.
	(Is_Body_Or_Package_Declaration): New routine.
	* sinfo.adb (In_Assertion): Rename to In_Assertion_Expression.
	(Set_In_Assertion): Rename to Set_In_Assertion_Expression.
	* sinfo.ads: Rename flag In_Assertion to In_Assertion_Expression
	to better reflect its use.  Update all places that mention the flag.
	(In_Assertion): Rename to In_Assertion_Expression. Update
	related pragma Inline.	(Set_In_Assertion): Rename to
	Set_In_Assertion_Expression. Update related pragma Inline.
	* snames.ads-tmpl: Add new predefined name Ghost. Add new pragma
	id Pragma_Ghost.

From-SVN: r197909

1 files changed, 53 insertions, 30 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 806b648..533834e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -5612,49 +5612,58 @@ package body Sem_Util is
    ---------------------------
 
    function Get_Subprogram_Entity (Nod : Node_Id) return Entity_Id is
-      Nam  : Node_Id;
-      Proc : Entity_Id;
+      Subp    : Node_Id;
+      Subp_Id : Entity_Id;
 
    begin
       if Nkind (Nod) = N_Accept_Statement then
-         Nam := Entry_Direct_Name (Nod);
+         Subp := Entry_Direct_Name (Nod);
+
+      elsif Nkind (Nod) = N_Slice then
+         Subp := Prefix (Nod);
+
+      else
+         Subp := Name (Nod);
+      end if;
+
+      --  Strip the subprogram call
+
+      loop
+         if Nkind_In (Subp, N_Explicit_Dereference,
+                            N_Indexed_Component,
+                            N_Selected_Component)
+         then
+            Subp := Prefix (Subp);
 
-      --  For an entry call, the prefix of the call is a selected component.
-      --  Need additional code for internal calls ???
+         elsif Nkind_In (Subp, N_Type_Conversion,
+                               N_Unchecked_Type_Conversion)
+         then
+            Subp := Expression (Subp);
 
-      elsif Nkind (Nod) = N_Entry_Call_Statement then
-         if Nkind (Name (Nod)) = N_Selected_Component then
-            Nam := Entity (Selector_Name (Name (Nod)));
          else
-            Nam := Empty;
+            exit;
          end if;
+      end loop;
 
-      else
-         Nam := Name (Nod);
-      end if;
+      --  Extract the entity of the subprogram call
 
-      if Nkind (Nam) = N_Explicit_Dereference then
-         Proc := Etype (Prefix (Nam));
-      elsif Is_Entity_Name (Nam) then
-         Proc := Entity (Nam);
-      else
-         return Empty;
-      end if;
+      if Is_Entity_Name (Subp) then
+         Subp_Id := Entity (Subp);
 
-      if Is_Object (Proc) then
-         Proc := Etype (Proc);
-      end if;
+         if Ekind (Subp_Id) = E_Access_Subprogram_Type then
+            Subp_Id := Directly_Designated_Type (Subp_Id);
+         end if;
 
-      if Ekind (Proc) = E_Access_Subprogram_Type then
-         Proc := Directly_Designated_Type (Proc);
-      end if;
+         if Is_Subprogram (Subp_Id) then
+            return Subp_Id;
+         else
+            return Empty;
+         end if;
+
+      --  The search did not find a construct that denotes a subprogram
 
-      if not Is_Subprogram (Proc)
-        and then Ekind (Proc) /= E_Subprogram_Type
-      then
-         return Empty;
       else
-         return Proc;
+         return Empty;
       end if;
    end Get_Subprogram_Entity;
 
@@ -7714,6 +7723,20 @@ package body Sem_Util is
       end if;
    end Is_Atomic_Object;
 
+   ------------------------------------
+   -- Is_Body_Or_Package_Declaration --
+   ------------------------------------
+
+   function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean is
+   begin
+      return Nkind_In (N, N_Entry_Body,
+                          N_Package_Body,
+                          N_Package_Declaration,
+                          N_Protected_Body,
+                          N_Subprogram_Body,
+                          N_Task_Body);
+   end Is_Body_Or_Package_Declaration;
+
    -----------------------
    -- Is_Bounded_String --
    -----------------------