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, 49 insertions, 6 deletions

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a8d3fe5..240eb0c 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -253,10 +253,15 @@ package body Sem_Prag is
       --  Pre-analyze the guard and consequence expressions of a Contract_Cases
       --  pragma/aspect aggregate expression.
 
+      ----------------------------
+      -- Analyze_Contract_Cases --
+      ----------------------------
+
       procedure Analyze_Contract_Cases (Aggr : Node_Id) is
          Case_Guard : Node_Id;
          Conseq     : Node_Id;
          Post_Case  : Node_Id;
+
       begin
          Post_Case := First (Component_Associations (Aggr));
          while Present (Post_Case) loop
@@ -266,19 +271,24 @@ package body Sem_Prag is
             --  Preanalyze the boolean expression, we treat this as a spec
             --  expression (i.e. similar to a default expression).
 
-            Preanalyze_Assert_Expression (Case_Guard, Standard_Boolean);
+            if Nkind (Case_Guard) /= N_Others_Choice then
+               Preanalyze_Assert_Expression (Case_Guard, Standard_Boolean);
+            end if;
+
             Preanalyze_Assert_Expression (Conseq, Standard_Boolean);
 
             Next (Post_Case);
          end loop;
       end Analyze_Contract_Cases;
 
+   --  Start of processing for Analyze_CTC_In_Decl_Part
+
    begin
       --  Install formals and push subprogram spec onto scope stack so that we
       --  can see the formals from the pragma.
 
-      Install_Formals (S);
       Push_Scope (S);
+      Install_Formals (S);
 
       --  Preanalyze the boolean expressions, we treat these as spec
       --  expressions (i.e. similar to a default expression).
@@ -11194,6 +11204,39 @@ package body Sem_Prag is
             end if;
          end Float_Representation;
 
+         -----------
+         -- Ghost --
+         -----------
+
+         --  pragma GHOST (function_LOCAL_NAME);
+
+         when Pragma_Ghost => Ghost : declare
+            Subp    : Node_Id;
+            Subp_Id : Entity_Id;
+
+         begin
+            GNAT_Pragma;
+            S14_Pragma;
+            Check_Arg_Count (1);
+            Check_Arg_Is_Local_Name (Arg1);
+
+            --  Ensure the proper placement of the pragma. Ghost must be
+            --  associated with a subprogram declaration.
+
+            Subp := Parent (Corresponding_Aspect (N));
+
+            if Nkind (Subp) /= N_Subprogram_Declaration then
+               Pragma_Misplaced;
+               return;
+            end if;
+
+            Subp_Id := Defining_Unit_Name (Specification (Subp));
+
+            if Ekind (Subp_Id) /= E_Function then
+               Error_Pragma ("pragma % must be applied to a function");
+            end if;
+         end Ghost;
+
          ------------
          -- Global --
          ------------
@@ -13542,14 +13585,12 @@ package body Sem_Prag is
                return;
             end if;
 
-            Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean);
+            Preanalyze_Assert_Expression (Expression (Arg1), Any_Boolean);
 
             --  Transform pragma Loop_Invariant into equivalent pragma Check
             --  Generate:
             --    pragma Check (Loop_Invaraint, Arg1);
 
-            --  Seems completely wrong to hijack pragma Check this way ???
-
             Rewrite (N,
               Make_Pragma (Loc,
                 Chars                        => Name_Check,
@@ -13625,7 +13666,8 @@ package body Sem_Prag is
                   Error_Pragma_Arg ("wrong change modifier", Variant);
                end if;
 
-               Preanalyze_And_Resolve (Expression (Variant), Any_Discrete);
+               Preanalyze_Assert_Expression
+                 (Expression (Variant), Any_Discrete);
 
                Next (Variant);
             end loop;
@@ -17762,6 +17804,7 @@ package body Sem_Prag is
       Pragma_Fast_Math                      => -1,
       Pragma_Finalize_Storage_Only          =>  0,
       Pragma_Float_Representation           =>  0,
+      Pragma_Ghost                          =>  0,
       Pragma_Global                         => -1,
       Pragma_Ident                          => -1,
       Pragma_Implementation_Defined         => -1,