diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 136 | ||||
| -rw-r--r-- | gcc/ada/exp_ch11.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 81 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 81 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 42 | ||||
| -rw-r--r-- | gcc/ada/exp_ch8.adb | 60 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 36 | ||||
| -rw-r--r-- | gcc/ada/exp_prag.adb | 84 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 62 | ||||
| -rw-r--r-- | gcc/ada/ghost.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/ghost.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/sem_ch11.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 129 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 135 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 53 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 85 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 67 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 30 |
26 files changed, 497 insertions, 890 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 302c4e7..050a304 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,139 @@ +2015-10-16 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch3.adb (Expand_N_Full_Type_Declaration): Do not capture, + set and restore the Ghost mode. + (Expand_N_Object_Declaration): Do not capture, set and restore the + Ghost mode. + (Freeze_Type): Redo the capture and restore of the Ghost mode. + (Restore_Globals): Removed. + * exp_ch5.adb (Expand_N_Assignment_Statement): Redo the capture + and restore of the Ghost mode. + (Restore_Globals): Removed. + * exp_ch6.adb (Expand_N_Procedure_Call_Statement): + Redo the capture and restore of the Ghost mode. + (Expand_N_Subprogram_Body): Redo the capture, set and restore + of the Ghost mode. + (Expand_N_Subprogram_Declaration): Do not + capture, set and restore the Ghost mode. + (Restore_Globals): Removed. + * exp_ch7.adb (Expand_N_Package_Body): Redo the capture, set + and restore of the Ghost mode. + (Expand_N_Package_Declaration): Do not capture, set and restore the + Ghost mode. + * exp_ch8.adb (Expand_N_Exception_Renaming_Declaration): + Redo the capture and restore of the Ghost mode. + (Expand_N_Object_Renaming_Declaration): Redo + the capture and restore of the Ghost mode. + (Expand_N_Package_Renaming_Declaration): + Redo the capture and restore of the Ghost mode. + (Expand_N_Subprogram_Renaming_Declaration): Redo the capture + and restore of the Ghost mode. + * exp_ch11.adb Remove with and use clauses for Ghost. + (Expand_N_Exception_Declaration): Do not capture, set and restore + the Ghost mode. + * exp_disp.adb (Make_DT): Redo the capture and restore of the + Ghost mode. + (Restore_Globals): Removed. + * exp_prag.adb (Expand_Pragma_Check): Do not capture, set + and restore the Ghost mode. + (Expand_Pragma_Contract_Cases): + Redo the capture and restore of the Ghost mode. Preserve the + original context of contract cases by setting / resetting the + In_Assertion_Expr counter. + (Expand_Pragma_Initial_Condition): + Redo the capture and restore of the Ghost mode. + (Expand_Pragma_Loop_Variant): Redo the capture and restore of + the Ghost mode. + (Restore_Globals): Removed. + * exp_util.adb (Make_Predicate_Call): Redo the capture and + restore of the Ghost mode. + (Restore_Globals): Removed. + * freeze.adb (Freeze_Entity): Redo the capture and restore of + the Ghost mode. + (Restore_Globals): Removed. + * ghost.adb (Check_Ghost_Context): Remove the RM reference from + the error message. + (Is_OK_Statement): Account for statements + that appear in assertion expressions. + (Is_Subject_To_Ghost): + Moved from spec. + * ghost.ads (Is_Subject_To_Ghost): Moved to body. + * rtsfind.ads (Load_RTU): Redo the capture and restore of the + Ghost mode. + * sem.adb Add with and use clauses for Ghost. + (Analyze): Redo + the capture and restore of the Ghost mode. Set the Ghost mode + when analyzing a declaration. + (Do_Analyze): Redo the capture + and restore of the Ghost mode. + * sem_ch3.adb (Analyze_Full_Type_Declaration): Do not capture, set + and restore the Ghost mode. + (Analyze_Incomplete_Type_Decl): + Do not capture, set and restore the Ghost mode. + (Analyze_Number_Declaration): Do not capture, set and restore the + Ghost mode. + (Analyze_Object_Declaration): Do not capture, set and + restore the Ghost mode. + (Analyze_Private_Extension_Declaration): + Do not capture, set and restore the Ghost mode. + (Analyze_Subtype_Declaration): Do not capture, set and restore + the Ghost mode. + (Restore_Globals): Removed. + * sem_ch5.adb (Analyze_Assignment): Redo the capture and restore + of the Ghost mode. + (Restore_Globals): Removed. + * sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): + Do not capture, set and restore the Ghost mode. + (Analyze_Procedure_Call): Redo the capture and restore of the + Ghost mode. + (Analyze_Subprogram_Body_Helper): Redo the capture + and restore of the Ghost mode. (Analyze_Subprogram_Declaration): + Do not capture, set and restore the Ghost mode. + (Restore_Globals): Removed. + * sem_ch7.adb (Analyze_Package_Body_Helper): Redo the capture and + restore of the Ghost mode. + (Analyze_Package_Declaration): + Do not capture, set and restore the Ghost mode. + (Analyze_Private_Type_Declaration): Do not capture, set and + restore the Ghost mode. + (Restore_Globals): Removed. + * sem_ch8.adb (Analyze_Exception_Renaming): Do not capture, + set and restore the Ghost mode. + (Analyze_Generic_Renaming): Do not capture, set and restore the Ghost + mode. + (Analyze_Object_Renaming): Do not capture, set and restore the + Ghost mode. + (Analyze_Package_Renaming): Do not capture, set and restore the Ghost + mode. + (Analyze_Subprogram_Renaming): Do not capture, set and restore the + Ghost mode. + (Restore_Globals): Removed. + * sem_ch11.adb (Analyze_Exception_Declaration): Do not capture, + set and restore the Ghost mode. + * sem_ch12.adb (Analyze_Generic_Package_Declaration): + Do not capture, set and restore the Ghost mode. + (Analyze_Generic_Subprogram_Declaration): Do not capture, set + and restore the Ghost mode. + * sem_ch13.adb (Build_Invariant_Procedure_Declaration): Redo + the capture and restore of the Ghost mode. + * sem_prag.adb (Analyze_Contract_Cases_In_Decl_Part): + Redo the capture and restore of the Ghost mode. + (Analyze_External_Property_In_Decl_Part): + Redo the capture and restore of the Ghost mode. + (Analyze_Initial_Condition_In_Decl_Part): Redo the + capture and restore of the Ghost mode. (Analyze_Pragma): + Do not capture, set and restore the Ghost mode for Assert. + Redo the capture and restore of the Ghost mode for Check. Do + not capture and restore the Ghost mode for Invariant. + (Analyze_Pre_Post_Condition_In_Decl_Part): Redo the capture and + restore of the Ghost mode. + * sem_res.adb (Resolve): Capture, set and restore the Ghost mode + when resolving a declaration. + * sem_util.adb (Build_Default_Init_Cond_Procedure_Body): + Redo the capture and restore of the Ghost mode. + (Build_Default_Init_Cond_Procedure_Declaration): Redo the capture + and restore of the Ghost mode. + 2015-10-16 Bob Duff <duff@adacore.com> * debug.adb: Document -gnatdQ switch. diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 47c3730..6ffc8a0 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -31,7 +31,6 @@ with Errout; use Errout; with Exp_Ch7; use Exp_Ch7; with Exp_Intr; use Exp_Intr; with Exp_Util; use Exp_Util; -with Ghost; use Ghost; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -1190,9 +1189,8 @@ package body Exp_Ch11 is -- end if; procedure Expand_N_Exception_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Id : constant Entity_Id := Defining_Identifier (N); - Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Identifier (N); + Loc : constant Source_Ptr := Sloc (N); Ex_Id : Entity_Id; Flag_Id : Entity_Id; L : List_Id; @@ -1279,12 +1277,6 @@ package body Exp_Ch11 is return; end if; - -- The exception declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - -- Definition of the external name: nam : constant String := "A.B.NAME"; Ex_Id := @@ -1391,11 +1383,6 @@ package body Exp_Ch11 is Insert_List_After_And_Analyze (N, L); end if; end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Expand_N_Exception_Declaration; --------------------------------------------- diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 885e63a..8574ba0 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4786,21 +4786,14 @@ package body Exp_Ch3 is -- Local declarations - Def_Id : constant Entity_Id := Defining_Identifier (N); - B_Id : constant Entity_Id := Base_Type (Def_Id); - GM : constant Ghost_Mode_Type := Ghost_Mode; + Def_Id : constant Entity_Id := Defining_Identifier (N); + B_Id : constant Entity_Id := Base_Type (Def_Id); FN : Node_Id; Par_Id : Entity_Id; -- Start of processing for Expand_N_Full_Type_Declaration begin - -- The type declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - if Is_Access_Type (Def_Id) then Build_Master (Def_Id); @@ -4924,11 +4917,6 @@ package body Exp_Ch3 is end if; end; end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Expand_N_Full_Type_Declaration; --------------------------------- @@ -4936,13 +4924,12 @@ package body Exp_Ch3 is --------------------------------- procedure Expand_N_Object_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Def_Id : constant Entity_Id := Defining_Identifier (N); - Expr : constant Node_Id := Expression (N); - GM : constant Ghost_Mode_Type := Ghost_Mode; - Obj_Def : constant Node_Id := Object_Definition (N); - Typ : constant Entity_Id := Etype (Def_Id); - Base_Typ : constant Entity_Id := Base_Type (Typ); + Loc : constant Source_Ptr := Sloc (N); + Def_Id : constant Entity_Id := Defining_Identifier (N); + Expr : constant Node_Id := Expression (N); + Obj_Def : constant Node_Id := Object_Definition (N); + Typ : constant Entity_Id := Etype (Def_Id); + Base_Typ : constant Entity_Id := Base_Type (Typ); Expr_Q : Node_Id; function Build_Equivalent_Aggregate return Boolean; @@ -4954,9 +4941,6 @@ package body Exp_Ch3 is -- Generate all default initialization actions for object Def_Id. Any -- new code is inserted after node After. - procedure Restore_Globals; - -- Restore the values of all saved global variables - function Rewrite_As_Renaming return Boolean; -- Indicate whether to rewrite a declaration with initialization into an -- object renaming declaration (see below). @@ -5387,15 +5371,6 @@ package body Exp_Ch3 is end if; end Default_Initialize_Object; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - ------------------------- -- Rewrite_As_Renaming -- ------------------------- @@ -5439,12 +5414,6 @@ package body Exp_Ch3 is return; end if; - -- The object declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - -- First we do special processing for objects of a tagged type where -- this is the point at which the type is frozen. The creation of the -- dispatch table and the initialization procedure have to be deferred @@ -5613,7 +5582,6 @@ package body Exp_Ch3 is and then Is_Build_In_Place_Function_Call (Expr_Q) then Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q); - Restore_Globals; -- The previous call expands the expression initializing the -- built-in-place object into further code that will be analyzed @@ -5858,7 +5826,6 @@ package body Exp_Ch3 is end; end if; - Restore_Globals; return; -- Common case of explicit object initialization @@ -5974,7 +5941,6 @@ package body Exp_Ch3 is -- to avoid its management in the backend Set_Expression (N, Empty); - Restore_Globals; return; -- Handle initialization of limited tagged types @@ -6196,13 +6162,10 @@ package body Exp_Ch3 is end; end if; - Restore_Globals; - -- Exception on library entity not available exception when RE_Not_Available => - Restore_Globals; return; end Expand_N_Object_Declaration; @@ -7523,10 +7486,6 @@ package body Exp_Ch3 is -- node using Append_Freeze_Actions. function Freeze_Type (N : Node_Id) return Boolean is - GM : constant Ghost_Mode_Type := Ghost_Mode; - -- Save the current Ghost mode in effect in case the type being frozen - -- sets a different mode. - procedure Process_RACW_Types (Typ : Entity_Id); -- Validate and generate stubs for all RACW types associated with type -- Typ. @@ -7535,9 +7494,6 @@ package body Exp_Ch3 is -- Associate type Typ's Finalize_Address primitive with the finalization -- masters of pending access-to-Typ types. - procedure Restore_Globals; - -- Restore the values of all saved global variables - ------------------------ -- Process_RACW_Types -- ------------------------ @@ -7618,26 +7574,19 @@ package body Exp_Ch3 is end if; end Process_Pending_Access_Types; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - -- Local variables Def_Id : constant Entity_Id := Entity (N); Result : Boolean := False; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- Start of processing for Freeze_Type begin - -- The type being frozen may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- freezing are properly flagged as ignored Ghost. + -- The type being frozen may be subject to pragma Ghost. Set the mode + -- now to ensure that any nodes generated during freezing are properly + -- marked as Ghost. Set_Ghost_Mode (N, Def_Id); @@ -7954,12 +7903,12 @@ package body Exp_Ch3 is Process_Pending_Access_Types (Def_Id); Freeze_Stream_Operations (N, Def_Id); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; exception when RE_Not_Available => - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return False; end Freeze_Type; diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 8cb7733..3584202 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1627,22 +1627,6 @@ package body Exp_Ch5 is -- cannot just be passed on to the back end in untransformed state. procedure Expand_N_Assignment_Statement (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - - procedure Restore_Globals; - -- Restore the values of all saved global variables - - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - - -- Local variables - Crep : constant Boolean := Change_Of_Representation (N); Lhs : constant Node_Id := Name (N); Loc : constant Source_Ptr := Sloc (N); @@ -1650,12 +1634,12 @@ package body Exp_Ch5 is Typ : constant Entity_Id := Underlying_Type (Etype (Lhs)); Exp : Node_Id; - -- Start of processing for Expand_N_Assignment_Statement + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; begin - -- The assignment statement may be Ghost if the left hand side is Ghost. + -- The assignment statement is Ghost when the left hand side is Ghost. -- Set the mode now to ensure that any nodes generated during expansion - -- are properly flagged as ignored Ghost. + -- are properly marked as Ghost. Set_Ghost_Mode (N); @@ -1668,7 +1652,7 @@ package body Exp_Ch5 is if Componentwise_Assignment (N) then Expand_Assign_Record (N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -1763,7 +1747,7 @@ package body Exp_Ch5 is Rewrite (N, Call); Analyze (N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; end; @@ -1914,7 +1898,7 @@ package body Exp_Ch5 is Rewrite (N, Make_Null_Statement (Loc)); Analyze (N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -2134,7 +2118,7 @@ package body Exp_Ch5 is if not Crep then Expand_Bit_Packed_Element_Set (N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; -- Change of representation case @@ -2186,7 +2170,7 @@ package body Exp_Ch5 is -- Nothing to do for valuetypes -- ??? Set_Scope_Is_Transient (False); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; elsif Is_Tagged_Type (Typ) @@ -2242,7 +2226,7 @@ package body Exp_Ch5 is -- expansion, since they would be missed in -gnatc mode ??? Error_Msg_N ("assignment not available on limited type", N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -2413,7 +2397,7 @@ package body Exp_Ch5 is -- it with all checks suppressed. Analyze (N, Suppress => All_Checks); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end Tagged_Case; @@ -2431,7 +2415,7 @@ package body Exp_Ch5 is end loop; Expand_Assign_Array (N, Actual_Rhs); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end; @@ -2439,7 +2423,7 @@ package body Exp_Ch5 is elsif Is_Record_Type (Typ) then Expand_Assign_Record (N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; -- Scalar types. This is where we perform the processing related to the @@ -2552,11 +2536,11 @@ package body Exp_Ch5 is end if; end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; exception when RE_Not_Available => - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end Expand_N_Assignment_Statement; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 67caf2f..e6efc3a 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4917,20 +4917,17 @@ package body Exp_Ch6 is --------------------------------------- procedure Expand_N_Procedure_Call_Statement (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; begin - -- The procedure call may be Ghost if the name is Ghost. Set the mode - -- now to ensure that any nodes generated during expansion are properly - -- flagged as ignored Ghost. + -- The procedure call is Ghost when the name is Ghost. Set the mode now + -- to ensure that any nodes generated during expansion are properly set + -- as Ghost. Set_Ghost_Mode (N); - Expand_Call (N); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - Ghost_Mode := GM; + Expand_Call (N); + Ghost_Mode := Save_Ghost_Mode; end Expand_N_Procedure_Call_Statement; -------------------------------------- @@ -5005,10 +5002,9 @@ package body Exp_Ch6 is -- Wrap thread body procedure Expand_N_Subprogram_Body (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Loc : constant Source_Ptr := Sloc (N); - HSS : constant Node_Id := Handled_Statement_Sequence (N); - Body_Id : Entity_Id; + Body_Id : constant Entity_Id := Defining_Entity (N); + HSS : constant Node_Id := Handled_Statement_Sequence (N); + Loc : constant Source_Ptr := Sloc (N); Except_H : Node_Id; L : List_Id; Spec_Id : Entity_Id; @@ -5019,9 +5015,6 @@ package body Exp_Ch6 is -- the latter test is not critical, it does not matter if we add a few -- extra returns, since they get eliminated anyway later on. - procedure Restore_Globals; - -- Restore the values of all saved global variables - ---------------- -- Add_Return -- ---------------- @@ -5094,23 +5087,25 @@ package body Exp_Ch6 is end if; end Add_Return; - --------------------- - -- Restore_Globals -- - --------------------- + -- Local varaibles - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Expand_N_Subprogram_Body begin - -- The subprogram body may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- expansion are flagged as ignored Ghost. + if Present (Corresponding_Spec (N)) then + Spec_Id := Corresponding_Spec (N); + else + Spec_Id := Body_Id; + end if; - Set_Ghost_Mode (N); + -- The subprogram body is Ghost when it is stand alone and subject to + -- pragma Ghost or the corresponding spec is Ghost. To accomodate both + -- cases, set the mode now to ensure that any nodes generated during + -- expansion are marked as Ghost. + + Set_Ghost_Mode (N, Spec_Id); -- Set L to either the list of declarations if present, or to the list -- of statements if no declarations are present. This is used to insert @@ -5164,16 +5159,6 @@ package body Exp_Ch6 is end; end if; - -- Find entity for subprogram - - Body_Id := Defining_Entity (N); - - if Present (Corresponding_Spec (N)) then - Spec_Id := Corresponding_Spec (N); - else - Spec_Id := Body_Id; - end if; - -- Need poll on entry to subprogram if polling enabled. We only do this -- for non-empty subprograms, since it does not seem necessary to poll -- for a dummy null subprogram. @@ -5288,7 +5273,7 @@ package body Exp_Ch6 is Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List (Make_Null_Statement (Loc)))); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; end if; @@ -5424,7 +5409,7 @@ package body Exp_Ch6 is Unest_Bodies.Append ((Spec_Id, N)); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; end Expand_N_Subprogram_Body; ----------------------------------- @@ -5451,21 +5436,14 @@ package body Exp_Ch6 is -- If the declaration is for a null procedure, emit null body procedure Expand_N_Subprogram_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - GM : constant Ghost_Mode_Type := Ghost_Mode; - Subp : constant Entity_Id := Defining_Entity (N); - Scop : constant Entity_Id := Scope (Subp); + Loc : constant Source_Ptr := Sloc (N); + Subp : constant Entity_Id := Defining_Entity (N); + Scop : constant Entity_Id := Scope (Subp); Prot_Bod : Node_Id; Prot_Decl : Node_Id; Prot_Id : Entity_Id; begin - -- The subprogram declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- expansion are flagged as ignored Ghost. - - Set_Ghost_Mode (N); - -- In SPARK, subprogram declarations are only allowed in package -- specifications. @@ -5566,11 +5544,6 @@ package body Exp_Ch6 is Set_Is_Inlined (Subp, False); end; end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Expand_N_Subprogram_Declaration; -------------------------------- diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 23d97d5..a45b911 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4177,26 +4177,27 @@ package body Exp_Ch7 is -- Encode entity names in package body procedure Expand_N_Package_Body (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Spec_Ent : constant Entity_Id := Corresponding_Spec (N); - Fin_Id : Entity_Id; + Spec_Id : constant Entity_Id := Corresponding_Spec (N); + Fin_Id : Entity_Id; + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; begin - -- The package body may be subject to pragma Ghost with policy Ignore. - -- Set the mode now to ensure that any nodes generated during expansion - -- are properly flagged as ignored Ghost. + -- The package body is Ghost when the corresponding spec is Ghost. Set + -- the mode now to ensure that any nodes generated during expansion are + -- properly marked as Ghost. - Set_Ghost_Mode (N); + Set_Ghost_Mode (N, Spec_Id); -- This is done only for non-generic packages - if Ekind (Spec_Ent) = E_Package then + if Ekind (Spec_Id) = E_Package then Push_Scope (Corresponding_Spec (N)); -- Build dispatch tables of library level tagged types if Tagged_Type_Expansion - and then Is_Library_Level_Entity (Spec_Ent) + and then Is_Library_Level_Entity (Spec_Id) then Build_Static_Dispatch_Tables (N); end if; @@ -4207,7 +4208,7 @@ package body Exp_Ch7 is -- assertion expression must be verified at the end of the body -- statements. - if Present (Get_Pragma (Spec_Ent, Pragma_Initial_Condition)) then + if Present (Get_Pragma (Spec_Id, Pragma_Initial_Condition)) then Expand_Pragma_Initial_Condition (N); end if; @@ -4215,13 +4216,13 @@ package body Exp_Ch7 is end if; Set_Elaboration_Flag (N, Corresponding_Spec (N)); - Set_In_Package_Body (Spec_Ent, False); + Set_In_Package_Body (Spec_Id, False); -- Set to encode entity names in package body before gigi is called Qualify_Entity_Names (N); - if Ekind (Spec_Ent) /= E_Generic_Package then + if Ekind (Spec_Id) /= E_Generic_Package then Build_Finalizer (N => N, Clean_Stmts => No_List, @@ -4244,10 +4245,7 @@ package body Exp_Ch7 is end if; end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Expand_N_Package_Body; ---------------------------------- @@ -4260,7 +4258,6 @@ package body Exp_Ch7 is -- appear. procedure Expand_N_Package_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Id : constant Entity_Id := Defining_Entity (N); Spec : constant Node_Id := Specification (N); Decls : List_Id; @@ -4304,12 +4301,6 @@ package body Exp_Ch7 is return; end if; - -- The package declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - -- For a package declaration that implies no associated body, generate -- task activation call and RACW supporting bodies now (since we won't -- have a specific separate compilation unit for that). @@ -4383,11 +4374,6 @@ package body Exp_Ch7 is Set_Finalizer (Id, Fin_Id); end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Expand_N_Package_Declaration; ----------------------------- diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index 2c47b7f..dfd1796 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -50,13 +50,15 @@ package body Exp_Ch8 is --------------------------------------------- procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + Decl : Node_Id; begin - -- The exception renaming declaration may be subject to pragma Ghost - -- with policy Ignore. Set the mode now to ensure that any nodes - -- generated during expansion are properly flagged as ignored Ghost. + -- The exception renaming declaration is Ghost when it is subject to + -- pragma Ghost or renames a Ghost entity. To accomodate both cases, set + -- the mode now to ensure that any nodes generated during expansion are + -- properly marked as Ghost. Set_Ghost_Mode (N); @@ -66,10 +68,7 @@ package body Exp_Ch8 is Insert_Action (N, Decl); end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Expand_N_Exception_Renaming_Declaration; ------------------------------------------ @@ -159,14 +158,15 @@ package body Exp_Ch8 is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Expand_N_Object_Renaming_Declaration begin - -- The object renaming declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during expansion are properly flagged as ignored Ghost. + -- The object renaming declaration is Ghost when it is subject to pragma + -- Ghost or renames a Ghost entity. To accomodate both cases, set the + -- mode now to ensure that any nodes generated during expansion are + -- properly marked as Ghost. Set_Ghost_Mode (N); @@ -213,10 +213,7 @@ package body Exp_Ch8 is Insert_Action (N, Decl); end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Expand_N_Object_Renaming_Declaration; ------------------------------------------- @@ -224,13 +221,15 @@ package body Exp_Ch8 is ------------------------------------------- procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + Decl : Node_Id; begin - -- The package renaming declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during expansion are properly flagged as ignored Ghost. + -- The package renaming declaration is Ghost when it is subject to + -- pragma Ghost or renames a Ghost entity. To accomodate both cases, + -- set the mode now to ensure that any nodes generated during expansion + -- are properly marked as Ghost. Set_Ghost_Mode (N); @@ -273,10 +272,7 @@ package body Exp_Ch8 is end if; end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Expand_N_Package_Renaming_Declaration; ---------------------------------------------- @@ -326,15 +322,16 @@ package body Exp_Ch8 is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; - Nam : constant Node_Id := Name (N); + Nam : constant Node_Id := Name (N); + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Expand_N_Subprogram_Renaming_Declaration begin - -- The subprogram renaming declaration may be subject to pragma Ghost - -- with policy Ignore. Set the mode now to ensure that any nodes created - -- during expansion are properly flagged as ignored Ghost. + -- The subprogram renaming declaration is Ghost when it is subject to + -- pragma Ghost or renames a Ghost entity. To accomodate both cases, set + -- the mode now to ensure that any nodes created during expansion are + -- properly flagged as ignored Ghost. Set_Ghost_Mode (N); @@ -402,10 +399,7 @@ package body Exp_Ch8 is end; end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Expand_N_Subprogram_Renaming_Declaration; end Exp_Ch8; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index f50899b..88965c7 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3645,10 +3645,6 @@ package body Exp_Disp is -- end; function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id is - GM : constant Ghost_Mode_Type := Ghost_Mode; - -- Save the current Ghost mode in effect in case the tagged type sets a - -- different mode. - Loc : constant Source_Ptr := Sloc (Typ); Max_Predef_Prims : constant Int := @@ -3711,9 +3707,6 @@ package body Exp_Disp is -- this secondary dispatch table by Make_Tags when its unique external -- name was generated. - procedure Restore_Globals; - -- Restore the values of all saved global variables - ------------------------------ -- Check_Premature_Freezing -- ------------------------------ @@ -4398,15 +4391,6 @@ package body Exp_Disp is Append_Elmt (Iface_DT, DT_Decl); end Make_Secondary_DT; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - -- Local variables Elab_Code : constant List_Id := New_List; @@ -4436,6 +4420,8 @@ package body Exp_Disp is TSD_Aggr_List : List_Id; TSD_Tags_List : List_Id; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- The following name entries are used by Make_DT to generate a number -- of entities related to a tagged type. These entities may be generated -- in a scope other than that of the tagged type declaration, and if @@ -4477,9 +4463,9 @@ package body Exp_Disp is begin pragma Assert (Is_Frozen (Typ)); - -- The tagged type being processed may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during dispatch table creation are properly flagged as ignored Ghost. + -- The tagged type being processed may be subject to pragma Ghost. Set + -- the mode now to ensure that any nodes generated during dispatch table + -- creation are properly marked as Ghost. Set_Ghost_Mode (Declaration_Node (Typ), Typ); @@ -4491,12 +4477,12 @@ package body Exp_Disp is or else Convention (Typ) = Convention_CIL or else Convention (Typ) = Convention_Java then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; elsif No_Run_Time_Mode then Error_Msg_CRT ("tagged types", Typ); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; elsif not RTE_Available (RE_Tag) then @@ -4512,7 +4498,7 @@ package body Exp_Disp is Analyze_List (Result, Suppress => All_Checks); Error_Msg_CRT ("tagged types", Typ); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end if; @@ -4523,14 +4509,14 @@ package body Exp_Disp is if RTE_Available (RE_Interface_Data) then if Max_Predef_Prims /= 15 then Error_Msg_N ("run-time library configuration error", Typ); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end if; else if Max_Predef_Prims /= 9 then Error_Msg_N ("run-time library configuration error", Typ); Error_Msg_CRT ("tagged types", Typ); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end if; end if; @@ -6264,7 +6250,7 @@ package body Exp_Disp is Register_CG_Node (Typ); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end Make_DT; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index a797f23..e80b5b9 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -303,9 +303,8 @@ package body Exp_Prag is -------------------------- procedure Expand_Pragma_Check (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Cond : constant Node_Id := Arg2 (N); - Nam : constant Name_Id := Chars (Arg1 (N)); + Cond : constant Node_Id := Arg2 (N); + Nam : constant Name_Id := Chars (Arg1 (N)); Msg : Node_Id; Loc : constant Source_Ptr := Sloc (First_Node (Cond)); @@ -329,16 +328,6 @@ package body Exp_Prag is return; end if; - -- Set the Ghost mode in effect from the pragma. In general both the - -- assertion policy and the Ghost policy of pragma Check must agree, - -- but there are cases where this can be circumvented. For instance, - -- a living subtype with an ignored predicate may be declared in one - -- packade, an ignored Ghost object in another and the compilation may - -- use -gnata to enable assertions. - -- ??? Ghost predicates are under redesign - - Set_Ghost_Mode (N); - -- Since this check is active, we rewrite the pragma into a -- corresponding if statement, and then analyze the statement. @@ -502,11 +491,6 @@ package body Exp_Prag is Error_Msg_N ("?A?check will fail at run time", N); end if; end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Expand_Pragma_Check; --------------------------------- @@ -992,7 +976,8 @@ package body Exp_Prag is Aggr : constant Node_Id := Expression (First (Pragma_Argument_Associations (CCs))); - GM : constant Ghost_Mode_Type := Ghost_Mode; + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; Case_Guard : Node_Id; CG_Checks : Node_Id; @@ -1027,12 +1012,20 @@ package body Exp_Prag is return; end if; - -- The contract cases may be subject to pragma Ghost with policy Ignore. - -- Set the mode now to ensure that any nodes generated during expansion - -- are properly flagged as ignored Ghost. + -- The contract cases is Ghost when it applies to a Ghost entity. Set + -- the mode now to ensure that any nodes generated during expansion are + -- properly flagged as Ghost. Set_Ghost_Mode (CCs); + -- The expansion of contract cases is quite distributed as it produces + -- various statements to evaluate the case guards and consequences. To + -- preserve the original context, set the Is_Assertion_Expr flag. This + -- aids the Ghost legality checks when verifying the placement of a + -- reference to a Ghost entity. + + In_Assertion_Expr := In_Assertion_Expr + 1; + Multiple_PCs := List_Length (Component_Associations (Aggr)) > 1; -- Create the counter which tracks the number of case guards that @@ -1258,10 +1251,8 @@ package body Exp_Prag is Append_To (Stmts, Conseq_Checks); - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + In_Assertion_Expr := In_Assertion_Expr - 1; + Ghost_Mode := Save_Ghost_Mode; end Expand_Pragma_Contract_Cases; --------------------------------------- @@ -1361,22 +1352,6 @@ package body Exp_Prag is ------------------------------------- procedure Expand_Pragma_Initial_Condition (Spec_Or_Body : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - - procedure Restore_Globals; - -- Restore the values of all saved global variables - - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - - -- Local variables - Loc : constant Source_Ptr := Sloc (Spec_Or_Body); Check : Node_Id; Expr : Node_Id; @@ -1384,7 +1359,7 @@ package body Exp_Prag is List : List_Id; Pack_Id : Entity_Id; - -- Start of processing for Expand_Pragma_Initial_Condition + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; begin if Nkind (Spec_Or_Body) = N_Package_Body then @@ -1424,9 +1399,9 @@ package body Exp_Prag is Init_Cond := Get_Pragma (Pack_Id, Pragma_Initial_Condition); - -- The initial condition be subject to pragma Ghost with policy Ignore. - -- Set the mode now to ensure that any nodes generated during expansion - -- are properly flagged as ignored Ghost. + -- The initial condition is Ghost when it applies to a Ghost entity. Set + -- the mode now to ensure that any nodes generated during expansion are + -- properly flagged as Ghost. Set_Ghost_Mode (Init_Cond); @@ -1442,7 +1417,7 @@ package body Exp_Prag is -- runtime check as it will repeat the illegality. if Error_Posted (Init_Cond) or else Error_Posted (Expr) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -1461,7 +1436,7 @@ package body Exp_Prag is Append_To (List, Check); Analyze (Check); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; end Expand_Pragma_Initial_Condition; ------------------------------------ @@ -1811,7 +1786,7 @@ package body Exp_Prag is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Expand_Pragma_Loop_Variant @@ -1825,9 +1800,9 @@ package body Exp_Prag is return; end if; - -- The loop variant may be subject to pragma Ghost with policy Ignore. - -- Set the mode now to ensure that any nodes generated during expansion - -- are properly flagged as ignored Ghost. + -- The loop variant is Ghost when it applies to a Ghost entity. Set + -- the mode now to ensure that any nodes generated during expansion + -- are properly flagged as Ghost. Set_Ghost_Mode (N); @@ -1892,10 +1867,7 @@ package body Exp_Prag is -- corresponding declarations and statements. We leave it in the tree -- for documentation purposes. It will be ignored by the backend. - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Expand_Pragma_Loop_Variant; -------------------------------- diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index eec7149..4cbb20b 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6424,34 +6424,17 @@ package body Exp_Util is Expr : Node_Id; Mem : Boolean := False) return Node_Id is - GM : constant Ghost_Mode_Type := Ghost_Mode; - - procedure Restore_Globals; - -- Restore the values of all saved global variables - - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - - -- Local variables - Loc : constant Source_Ptr := Sloc (Expr); Call : Node_Id; PFM : Entity_Id; - -- Start of processing for Make_Predicate_Call + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; begin pragma Assert (Present (Predicate_Function (Typ))); - -- The related type may be subject to pragma Ghost with policy Ignore. - -- Set the mode now to ensure that the call is properly flagged as - -- ignored Ghost. + -- The related type may be subject to pragma Ghost. Set the mode now to + -- ensure that the call is properly marked as Ghost. Set_Ghost_Mode_From_Entity (Typ); @@ -6466,7 +6449,7 @@ package body Exp_Util is Name => New_Occurrence_Of (PFM, Loc), Parameter_Associations => New_List (Relocate_Node (Expr))); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Call; end if; end if; @@ -6479,7 +6462,7 @@ package body Exp_Util is New_Occurrence_Of (Predicate_Function (Typ), Loc), Parameter_Associations => New_List (Relocate_Node (Expr))); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Call; end Make_Predicate_Call; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index c7ad86c..b270567 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1870,10 +1870,6 @@ package body Freeze is ------------------- function Freeze_Entity (E : Entity_Id; N : Node_Id) return List_Id is - GM : constant Ghost_Mode_Type := Ghost_Mode; - -- Save the current Ghost mode in effect in case the entity being frozen - -- sets a different mode. - Loc : constant Source_Ptr := Sloc (N); Atype : Entity_Id; Comp : Entity_Id; @@ -1945,9 +1941,6 @@ package body Freeze is -- call, but rather must go in the package holding the function, so that -- the backend can process it in the proper context. - procedure Restore_Globals; - -- Restore the values of all saved global variables - procedure Wrap_Imported_Subprogram (E : Entity_Id); -- If E is an entity for an imported subprogram with pre/post-conditions -- then this procedure will create a wrapper to ensure that proper run- @@ -4492,15 +4485,6 @@ package body Freeze is Append_List (Result, Decls); end Late_Freeze_Subprogram; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - ------------------------------ -- Wrap_Imported_Subprogram -- ------------------------------ @@ -4644,12 +4628,16 @@ package body Freeze is end if; end Wrap_Imported_Subprogram; + -- Local variables + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- Start of processing for Freeze_Entity begin - -- The entity being frozen may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- freezing are properly flagged as ignored Ghost. + -- The entity being frozen may be subject to pragma Ghost. Set the mode + -- now to ensure that any nodes generated during freezing are properly + -- flagged as Ghost. Set_Ghost_Mode_From_Entity (E); @@ -4668,7 +4656,7 @@ package body Freeze is -- Do not freeze if already frozen since we only need one freeze node if Is_Frozen (E) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; -- It is improper to freeze an external entity within a generic because @@ -4683,7 +4671,7 @@ package body Freeze is Analyze_Aspects_At_Freeze_Point (E); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; -- AI05-0213: A formal incomplete type does not freeze the actual. In @@ -4694,19 +4682,19 @@ package body Freeze is and then No (Full_View (Base_Type (E))) and then Ada_Version >= Ada_2012 then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; -- Formal subprograms are never frozen elsif Is_Formal_Subprogram (E) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; -- Generic types are never frozen as they lack delayed semantic checks elsif Is_Generic_Type (E) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; -- Do not freeze a global entity within an inner scope created during @@ -4740,7 +4728,7 @@ package body Freeze is then exit; else - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; end if; end if; @@ -4776,7 +4764,7 @@ package body Freeze is end loop; if No (S) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; end if; end; @@ -4784,7 +4772,7 @@ package body Freeze is elsif Ekind (E) = E_Generic_Package then Result := Freeze_Generic_Entities (E); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end if; @@ -4867,7 +4855,7 @@ package body Freeze is if not Is_Internal (E) then if not Freeze_Profile (E) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end if; end if; @@ -4892,7 +4880,7 @@ package body Freeze is if Late_Freezing then Late_Freeze_Subprogram (E); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; end if; @@ -5055,7 +5043,7 @@ package body Freeze is and then not Has_Delayed_Freeze (E)) then Check_Compile_Time_Size (E); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; end if; @@ -5330,7 +5318,7 @@ package body Freeze is if not Is_Frozen (Root_Type (E)) then Set_Is_Frozen (E, False); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end if; @@ -5466,7 +5454,7 @@ package body Freeze is and then not Present (Full_View (E)) then Set_Is_Frozen (E, False); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; -- Case of full view present @@ -5558,7 +5546,7 @@ package body Freeze is Set_RM_Size (E, RM_Size (Full_View (E))); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; -- Case of underlying full view present @@ -5588,7 +5576,7 @@ package body Freeze is Check_Debug_Info_Needed (E); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; -- Case of no full view present. If entity is derived or subtype, @@ -5602,7 +5590,7 @@ package body Freeze is else Set_Is_Frozen (E, False); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return No_List; end if; @@ -5651,7 +5639,7 @@ package body Freeze is -- generic processing), so we never need freeze nodes for them. if Is_Generic_Type (E) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end if; @@ -6267,7 +6255,7 @@ package body Freeze is end if; end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return Result; end Freeze_Entity; diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 05295a0..7380d9a 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -67,6 +67,12 @@ package body Ghost is -- Subsidiary to Check_Ghost_Context and Set_Ghost_Mode. Find the entity of -- a reference to a Ghost entity. Return Empty if there is no such entity. + function Is_Subject_To_Ghost (N : Node_Id) return Boolean; + -- Subsidiary to routines Is_OK_xxx and Set_Ghost_Mode. Determine whether + -- declaration or body N is subject to aspect or pragma Ghost. Use this + -- routine in cases where [source] pragma Ghost has not been analyzed yet, + -- but the context needs to establish the "ghostness" of N. + procedure Propagate_Ignored_Ghost_Code (N : Node_Id); -- Subsidiary to routines Mark_xxx_As_Ghost and Set_Ghost_Mode_From_xxx. -- Signal all enclosing scopes that they now contain ignored Ghost code. @@ -407,15 +413,27 @@ package body Ghost is -- Special cases - -- An if statement is a suitable context for a Ghost entity if it - -- is the byproduct of assertion expression expansion. + elsif Nkind (Stmt) = N_If_Statement then - elsif Nkind (Stmt) = N_If_Statement - and then Nkind (Original_Node (Stmt)) = N_Pragma - and then Assertion_Expression_Pragma - (Get_Pragma_Id (Original_Node (Stmt))) - then - return True; + -- An if statement is a suitable context for a Ghost entity if + -- it is the byproduct of assertion expression expansion. Note + -- that the assertion expression may not be related to a Ghost + -- entity, but it may still contain references to Ghost + -- entities. + + if Nkind (Original_Node (Stmt)) = N_Pragma + and then Assertion_Expression_Pragma + (Get_Pragma_Id (Original_Node (Stmt))) + then + return True; + + -- The expansion of pragma Contract_Cases produces various if + -- statements to evaluate all case guards. This is a suitable + -- context as Contract_Cases is an assertion expression. + + elsif In_Assertion_Expr > 0 then + return True; + end if; end if; return False; @@ -517,12 +535,10 @@ package body Ghost is Check_Ghost_Policy (Ghost_Id, Ghost_Ref); -- Otherwise the Ghost entity appears in a non-Ghost context and affects - -- its behavior or value. + -- its behavior or value (SPARK RM 6.9(11,12)). else - Error_Msg_N - ("ghost entity cannot appear in this context (SPARK RM 6.9(11))", - Ghost_Ref); + Error_Msg_N ("ghost entity cannot appear in this context", Ghost_Ref); end if; end Check_Ghost_Context; @@ -701,8 +717,8 @@ package body Ghost is Expr := Get_Pragma_Arg (Expr); end if; - -- Determine whether the expression of the aspect is static and - -- denotes True. + -- Determine whether the expression of the aspect or pragma is static + -- and denotes True. if Present (Expr) then Preanalyze_And_Resolve (Expr); diff --git a/gcc/ada/ghost.ads b/gcc/ada/ghost.ads index c267e70..c854629 100644 --- a/gcc/ada/ghost.ads +++ b/gcc/ada/ghost.ads @@ -66,12 +66,6 @@ package Ghost is -- Determine whether entity Id is Ghost. To qualify as such, the entity -- must be subject to pragma Ghost. - function Is_Subject_To_Ghost (N : Node_Id) return Boolean; - -- Determine whether declarative node N is subject to aspect or pragma - -- Ghost. Use this routine in cases where [source] pragma Ghost has not - -- been analyzed yet, but the context needs to establish the "ghostness" - -- of N. - procedure Lock; -- Lock internal tables before calling backend diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index c96e708..d6da171 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -925,9 +925,7 @@ package body Rtsfind is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; - -- Save the current Ghost mode in effect to ensure a clean environment - -- when analyzing the unit. + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Load_RTU @@ -1043,9 +1041,7 @@ package body Rtsfind is Set_Is_Potentially_Use_Visible (U.Entity, True); end if; - -- Restore the original Ghost mode now that analysis has taken place - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Load_RTU; -------------------- diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 0f8f173..a6f1be1 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -29,6 +29,7 @@ with Debug_A; use Debug_A; with Elists; use Elists; with Expander; use Expander; with Fname; use Fname; +with Ghost; use Ghost; with Lib; use Lib; with Lib.Load; use Lib.Load; with Nlists; use Nlists; @@ -95,9 +96,7 @@ package body Sem is ------------- procedure Analyze (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - -- Save the current Ghost mode in effect in case the construct sets a - -- different mode. + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; begin Debug_A_Entry ("analyzing ", N); @@ -109,6 +108,14 @@ package body Sem is return; end if; + -- A declaration may be subject to pragma Ghost. Set the mode now to + -- ensure that any nodes generated during analysis and expansion are + -- marked as Ghost. + + if Is_Declaration (N) then + Set_Ghost_Mode (N); + end if; + -- Otherwise processing depends on the node kind case Nkind (N) is @@ -720,10 +727,7 @@ package body Sem is Expand (N); end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Analyze; -- Version with check(s) suppressed @@ -1310,9 +1314,7 @@ package body Sem is ---------------- procedure Do_Analyze is - GM : constant Ghost_Mode_Type := Ghost_Mode; - -- Save the current Ghost mode in effect in case the compilation unit - -- is withed from a unit with a different Ghost mode. + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; List : Elist_Id; @@ -1343,7 +1345,7 @@ package body Sem is Pop_Scope; Restore_Scope_Stack (List); - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Do_Analyze; -- Local variables diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 82b59e92..86285ee 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -55,17 +55,10 @@ package body Sem_Ch11 is ----------------------------------- procedure Analyze_Exception_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Id : constant Entity_Id := Defining_Identifier (N); - PF : constant Boolean := Is_Pure (Current_Scope); + Id : constant Entity_Id := Defining_Identifier (N); + PF : constant Boolean := Is_Pure (Current_Scope); begin - -- The exception declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - Generate_Definition (Id); Enter_Name (Id); Set_Ekind (Id, E_Exception); @@ -83,11 +76,6 @@ package body Sem_Ch11 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Id); end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Exception_Declaration; -------------------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 4817625..e848307 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3135,7 +3135,6 @@ package body Sem_Ch12 is ------------------------------------------ procedure Analyze_Generic_Package_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Loc : constant Source_Ptr := Sloc (N); Decls : constant List_Id := Visible_Declarations (Specification (N)); @@ -3146,11 +3145,6 @@ package body Sem_Ch12 is Save_Parent : Node_Id; begin - -- The generic package declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); Check_SPARK_05_Restriction ("generic is not allowed", N); -- We introduce a renaming of the enclosing package, to have a usable @@ -3302,11 +3296,6 @@ package body Sem_Ch12 is end if; end; end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Generic_Package_Declaration; -------------------------------------------- @@ -3314,7 +3303,6 @@ package body Sem_Ch12 is -------------------------------------------- procedure Analyze_Generic_Subprogram_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Formals : List_Id; Id : Entity_Id; New_N : Node_Id; @@ -3324,12 +3312,6 @@ package body Sem_Ch12 is Typ : Entity_Id; begin - -- The generic subprogram declaration may be subject to pragma Ghost - -- with policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged as - -- ignored Ghost. - - Set_Ghost_Mode (N); Check_SPARK_05_Restriction ("generic is not allowed", N); -- Create copy of generic unit, and save for instantiation. If the unit @@ -3478,11 +3460,6 @@ package body Sem_Ch12 is Generate_Reference_To_Formals (Id); List_Inherited_Pre_Post_Aspects (Id); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Generic_Subprogram_Declaration; ----------------------------------- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index f532595..f05ad7f 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -7763,12 +7763,13 @@ package body Sem_Ch13 is function Build_Invariant_Procedure_Declaration (Typ : Entity_Id) return Node_Id is - Loc : constant Source_Ptr := Sloc (Typ); - GM : constant Ghost_Mode_Type := Ghost_Mode; + Loc : constant Source_Ptr := Sloc (Typ); Decl : Node_Id; Obj_Id : Entity_Id; SId : Entity_Id; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + begin -- Check for duplicate definitions @@ -7776,9 +7777,8 @@ package body Sem_Ch13 is return Empty; end if; - -- The related type may be subject to pragma Ghost with policy Ignore. - -- Set the mode now to ensure that the predicate functions are properly - -- flagged as ignored Ghost. + -- The related type may be subject to pragma Ghost. Set the mode now to + -- ensure that the predicate functions are properly marked as Ghost. Set_Ghost_Mode_From_Entity (Typ); @@ -7810,10 +7810,7 @@ package body Sem_Ch13 is Defining_Identifier => Obj_Id, Parameter_Type => New_Occurrence_Of (Typ, Loc))))); - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; return Decl; end Build_Invariant_Procedure_Declaration; @@ -8563,7 +8560,7 @@ package body Sem_Ch13 is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Build_Predicate_Functions @@ -8576,9 +8573,8 @@ package body Sem_Ch13 is return; end if; - -- The related type may be subject to pragma Ghost with policy Ignore. - -- Set the mode now to ensure that the predicate functions are properly - -- flagged as ignored Ghost. + -- The related type may be subject to pragma Ghost. Set the mode now to + -- ensure that the predicate functions are properly marked as Ghost. Set_Ghost_Mode_From_Entity (Typ); @@ -8927,10 +8923,7 @@ package body Sem_Ch13 is end; end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Build_Predicate_Functions; ----------------------------------------- diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 62cc791..9fec595 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2556,9 +2556,8 @@ package body Sem_Ch3 is ----------------------------------- procedure Analyze_Full_Type_Declaration (N : Node_Id) is - Def : constant Node_Id := Type_Definition (N); - Def_Id : constant Entity_Id := Defining_Identifier (N); - GM : constant Ghost_Mode_Type := Ghost_Mode; + Def : constant Node_Id := Type_Definition (N); + Def_Id : constant Entity_Id := Defining_Identifier (N); T : Entity_Id; Prev : Entity_Id; @@ -2576,9 +2575,6 @@ package body Sem_Ch3 is -- list later in Sem_Disp.Check_Operation_From_Incomplete_Type (which -- is called from Process_Incomplete_Dependents). - procedure Restore_Globals; - -- Restore the values of all saved global variables - ------------------------------------ -- Check_Ops_From_Incomplete_Type -- ------------------------------------ @@ -2616,26 +2612,11 @@ package body Sem_Ch3 is end if; end Check_Ops_From_Incomplete_Type; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - -- Start of processing for Analyze_Full_Type_Declaration begin Prev := Find_Type_Name (N); - -- The type declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N, Prev); - -- The full view, if present, now points to the current type. If there -- is an incomplete partial view, set a link to it, to simplify the -- retrieval of primitive operations of the type. @@ -2773,7 +2754,6 @@ package body Sem_Ch3 is end if; if Etype (T) = Any_Type then - Restore_Globals; return; end if; @@ -2914,8 +2894,6 @@ package body Sem_Ch3 is Analyze_Aspect_Specifications (N, Def_Id); end if; end if; - - Restore_Globals; end Analyze_Full_Type_Declaration; ---------------------------------- @@ -2923,18 +2901,12 @@ package body Sem_Ch3 is ---------------------------------- procedure Analyze_Incomplete_Type_Decl (N : Node_Id) is - F : constant Boolean := Is_Pure (Current_Scope); - GM : constant Ghost_Mode_Type := Ghost_Mode; - T : Entity_Id; + F : constant Boolean := Is_Pure (Current_Scope); + T : Entity_Id; begin Check_SPARK_05_Restriction ("incomplete type is not allowed", N); - -- The incomplete type declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); Generate_Definition (Defining_Identifier (N)); -- Process an incomplete declaration. The identifier must not have been @@ -2984,11 +2956,6 @@ package body Sem_Ch3 is Set_Private_Dependents (T, New_Elmt_List); Set_Is_Pure (T, F); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Incomplete_Type_Decl; ----------------------------------- @@ -3063,37 +3030,13 @@ package body Sem_Ch3 is -------------------------------- procedure Analyze_Number_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - - procedure Restore_Globals; - -- Restore the values of all saved global variables - - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - - -- Local variables - E : constant Node_Id := Expression (N); Id : constant Entity_Id := Defining_Identifier (N); Index : Interp_Index; It : Interp; T : Entity_Id; - -- Start of processing for Analyze_Number_Declaration - begin - -- The number declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - Generate_Definition (Id); Enter_Name (Id); @@ -3113,8 +3056,6 @@ package body Sem_Ch3 is Set_Etype (Id, Universal_Integer); Set_Ekind (Id, E_Named_Integer); Set_Is_Frozen (Id, True); - - Restore_Globals; return; end if; @@ -3216,8 +3157,6 @@ package body Sem_Ch3 is Set_Ekind (Id, E_Constant); Set_Never_Set_In_Source (Id, True); Set_Is_True_Constant (Id, True); - - Restore_Globals; return; end if; @@ -3231,8 +3170,6 @@ package body Sem_Ch3 is Rewrite (E, Make_Integer_Literal (Sloc (N), 1)); Set_Etype (E, Any_Type); end if; - - Restore_Globals; end Analyze_Number_Declaration; ----------------------------- @@ -3406,9 +3343,8 @@ package body Sem_Ch3 is -------------------------------- procedure Analyze_Object_Declaration (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - GM : constant Ghost_Mode_Type := Ghost_Mode; - Id : constant Entity_Id := Defining_Identifier (N); + Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Identifier (N); Act_T : Entity_Id; T : Entity_Id; @@ -3437,9 +3373,6 @@ package body Sem_Ch3 is -- Any other relevant delayed aspects on object declarations ??? - procedure Restore_Globals; - -- Restore the values of all saved global variables - ----------------- -- Count_Tasks -- ----------------- @@ -3518,14 +3451,9 @@ package body Sem_Ch3 is return False; end Delayed_Aspect_Present; - --------------------- - -- Restore_Globals -- - --------------------- + -- Local variables - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Analyze_Object_Declaration @@ -3580,9 +3508,10 @@ package body Sem_Ch3 is end if; end if; - -- The object declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- analysis and expansion are properly flagged as ignored Ghost. + -- The object declaration is Ghost when it is subject to pragma Ghost or + -- completes a deferred Ghost constant. Set the mode now to ensure that + -- any nodes generated during analysis and expansion are properly marked + -- as Ghost. Set_Ghost_Mode (N, Prev_Entity); @@ -3866,7 +3795,7 @@ package body Sem_Ch3 is and then Analyzed (N) and then No (Expression (N)) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -4139,7 +4068,7 @@ package body Sem_Ch3 is Freeze_Before (N, T); Set_Is_Frozen (Id); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; else @@ -4522,7 +4451,7 @@ package body Sem_Ch3 is Check_No_Hidden_State (Id); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Object_Declaration; --------------------------- @@ -4543,19 +4472,12 @@ package body Sem_Ch3 is ------------------------------------------- procedure Analyze_Private_Extension_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Indic : constant Node_Id := Subtype_Indication (N); - T : constant Entity_Id := Defining_Identifier (N); + Indic : constant Node_Id := Subtype_Indication (N); + T : constant Entity_Id := Defining_Identifier (N); Parent_Base : Entity_Id; Parent_Type : Entity_Id; begin - -- The private extension declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - -- Ada 2005 (AI-251): Decorate all names in list of ancestor interfaces if Is_Non_Empty_List (Interface_List (N)) then @@ -4769,11 +4691,6 @@ package body Sem_Ch3 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, T); end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Private_Extension_Declaration; --------------------------------- @@ -4784,18 +4701,11 @@ package body Sem_Ch3 is (N : Node_Id; Skip : Boolean := False) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Id : constant Entity_Id := Defining_Identifier (N); R_Checks : Check_Result; T : Entity_Id; begin - -- The subtype declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - Generate_Definition (Id); Set_Is_Pure (Id, Is_Pure (Current_Scope)); Init_Size_Align (Id); @@ -5393,11 +5303,6 @@ package body Sem_Ch3 is end if; Analyze_Dimension (N); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Subtype_Declaration; -------------------------------- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 2b2e918..aaa1fcd 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -90,9 +90,8 @@ package body Sem_Ch5 is ------------------------ procedure Analyze_Assignment (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Lhs : constant Node_Id := Name (N); - Rhs : constant Node_Id := Expression (N); + Lhs : constant Node_Id := Name (N); + Rhs : constant Node_Id := Expression (N); T1 : Entity_Id; T2 : Entity_Id; Decl : Node_Id; @@ -107,9 +106,6 @@ package body Sem_Ch5 is -- the assignment, and at the end of processing before setting any new -- current values in place. - procedure Restore_Globals; - -- Restore the values of all saved global variables - procedure Set_Assignment_Type (Opnd : Node_Id; Opnd_Type : in out Entity_Id); @@ -215,15 +211,6 @@ package body Sem_Ch5 is end if; end Kill_Lhs; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - ------------------------- -- Set_Assignment_Type -- ------------------------- @@ -282,6 +269,10 @@ package body Sem_Ch5 is end if; end Set_Assignment_Type; + -- Local variables + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- Start of processing for Analyze_Assignment begin @@ -293,10 +284,9 @@ package body Sem_Ch5 is Analyze (Lhs); - -- The left hand side of an assignment may reference an entity subject - -- to pragma Ghost with policy Ignore. Set the mode now to ensure that - -- any nodes generated during analysis and expansion are properly - -- flagged as ignored Ghost. + -- An assignment statement is Ghost when the left hand side denotes a + -- Ghost entity. Set the mode now to ensure that any nodes generated + -- during analysis and expansion are properly marked as Ghost. Set_Ghost_Mode (N); Analyze (Rhs); @@ -391,7 +381,7 @@ package body Sem_Ch5 is Error_Msg_N ("no valid types for left-hand side for assignment", Lhs); Kill_Lhs; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; end if; @@ -467,14 +457,14 @@ package body Sem_Ch5 is "specified??", Lhs); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; end if; end; Diagnose_Non_Variable_Lhs (Lhs); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; -- Error of assigning to limited type. We do however allow this in @@ -495,7 +485,7 @@ package body Sem_Ch5 is Explain_Limited_Type (T1, Lhs); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; -- Enforce RM 3.9.3 (8): the target of an assignment operation cannot be @@ -534,7 +524,7 @@ package body Sem_Ch5 is then Error_Msg_N ("invalid use of incomplete type", Lhs); Kill_Lhs; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -552,7 +542,7 @@ package body Sem_Ch5 is if Rhs = Error then Kill_Lhs; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -561,7 +551,7 @@ package body Sem_Ch5 is if not Covers (T1, T2) then Wrong_Type (Rhs, Etype (Lhs)); Kill_Lhs; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -589,7 +579,7 @@ package body Sem_Ch5 is if T1 = Any_Type or else T2 = Any_Type then Kill_Lhs; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -682,7 +672,7 @@ package body Sem_Ch5 is -- to reset Is_True_Constant, and desirable for xref purposes. Note_Possible_Modification (Lhs, Sure => True); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; -- If we know the right hand side is non-null, then we convert to the @@ -889,7 +879,7 @@ package body Sem_Ch5 is end; Analyze_Dimension (N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Assignment; ----------------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4f6038e..4ae437e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -209,18 +209,11 @@ package body Sem_Ch6 is --------------------------------------------- procedure Analyze_Abstract_Subprogram_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Scop : constant Entity_Id := Current_Scope; - Subp_Id : constant Entity_Id := + Scop : constant Entity_Id := Current_Scope; + Subp_Id : constant Entity_Id := Analyze_Subprogram_Specification (Specification (N)); begin - -- The abstract subprogram declaration may be subject to pragma Ghost - -- with policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged as - -- ignored Ghost. - - Set_Ghost_Mode (N); Check_SPARK_05_Restriction ("abstract subprogram is not allowed", N); Generate_Definition (Subp_Id); @@ -261,11 +254,6 @@ package body Sem_Ch6 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Subp_Id); end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Abstract_Subprogram_Declaration; --------------------------------- @@ -1547,15 +1535,10 @@ package body Sem_Ch6 is ---------------------------- procedure Analyze_Procedure_Call (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - procedure Analyze_Call_And_Resolve; -- Do Analyze and Resolve calls for procedure call -- At end, check illegal order dependence. - procedure Restore_Globals; - -- Restore the values of all saved global variables - ------------------------------ -- Analyze_Call_And_Resolve -- ------------------------------ @@ -1570,15 +1553,6 @@ package body Sem_Ch6 is end if; end Analyze_Call_And_Resolve; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - -- Local variables Actuals : constant List_Id := Parameter_Associations (N); @@ -1587,6 +1561,8 @@ package body Sem_Ch6 is Actual : Node_Id; New_N : Node_Id; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- Start of processing for Analyze_Procedure_Call begin @@ -1618,10 +1594,9 @@ package body Sem_Ch6 is return; end if; - -- The name of the procedure call may reference an entity subject to - -- pragma Ghost with policy Ignore. Set the mode now to ensure that any - -- nodes generated during analysis and expansion are properly flagged as - -- ignored Ghost. + -- A procedure call is Ghost when its name denotes a Ghost procedure. + -- Set the mode now to ensure that any nodes generated during analysis + -- and expansion are properly marked as Ghost. Set_Ghost_Mode (N); @@ -1657,7 +1632,7 @@ package body Sem_Ch6 is and then Is_Record_Type (Etype (Entity (P))) and then Remote_AST_I_Dereference (P) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; elsif Is_Entity_Name (P) @@ -1794,7 +1769,7 @@ package body Sem_Ch6 is Error_Msg_N ("invalid procedure or entry call", N); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Procedure_Call; ------------------------------ @@ -2275,7 +2250,6 @@ package body Sem_Ch6 is -- the subprogram, or to perform conformance checks. procedure Analyze_Subprogram_Body_Helper (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Loc : constant Source_Ptr := Sloc (N); Body_Spec : Node_Id := Specification (N); Body_Id : Entity_Id := Defining_Entity (Body_Spec); @@ -2351,9 +2325,6 @@ package body Sem_Ch6 is -- Determine whether subprogram Subp_Id is a primitive of a concurrent -- type that implements an interface and has a private view. - procedure Restore_Globals; - -- Restore the values of all saved global variables - procedure Set_Trivial_Subprogram (N : Node_Id); -- Sets the Is_Trivial_Subprogram flag in both spec and body of the -- subprogram whose body is being analyzed. N is the statement node @@ -2930,15 +2901,6 @@ package body Sem_Ch6 is return False; end Is_Private_Concurrent_Primitive; - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - ---------------------------- -- Set_Trivial_Subprogram -- ---------------------------- @@ -3046,6 +3008,10 @@ package body Sem_Ch6 is end if; end Verify_Overriding_Indicator; + -- Local variables + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- Start of processing for Analyze_Subprogram_Body_Helper begin @@ -3065,10 +3031,10 @@ package body Sem_Ch6 is if Is_Generic_Subprogram (Prev_Id) then Spec_Id := Prev_Id; - -- The corresponding spec may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged - -- as ignored Ghost. + -- A subprogram body is Ghost when it is stand alone and subject + -- to pragma Ghost or when the corresponding spec is Ghost. Set + -- the mode now to ensure that any nodes generated during analysis + -- and expansion are properly marked as Ghost. Set_Ghost_Mode (N, Spec_Id); Set_Is_Compilation_Unit (Body_Id, Is_Compilation_Unit (Spec_Id)); @@ -3081,7 +3047,7 @@ package body Sem_Ch6 is Check_Missing_Return; end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; else @@ -3089,7 +3055,7 @@ package body Sem_Ch6 is -- enter name will post error. Enter_Name (Body_Id); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -3100,7 +3066,7 @@ package body Sem_Ch6 is -- analysis. elsif Prev_Id = Body_Id and then Has_Completion (Body_Id) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; else @@ -3112,20 +3078,20 @@ package body Sem_Ch6 is if Is_Private_Concurrent_Primitive (Body_Id) then Spec_Id := Disambiguate_Spec; - -- The corresponding spec may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged - -- as ignored Ghost. + -- A subprogram body is Ghost when it is stand alone and + -- subject to pragma Ghost or when the corresponding spec is + -- Ghost. Set the mode now to ensure that any nodes generated + -- during analysis and expansion are properly marked as Ghost. Set_Ghost_Mode (N, Spec_Id); else Spec_Id := Find_Corresponding_Spec (N); - -- The corresponding spec may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged - -- as ignored Ghost. + -- A subprogram body is Ghost when it is stand alone and + -- subject to pragma Ghost or when the corresponding spec is + -- Ghost. Set the mode now to ensure that any nodes generated + -- during analysis and expansion are properly marked as Ghost. Set_Ghost_Mode (N, Spec_Id); @@ -3179,7 +3145,7 @@ package body Sem_Ch6 is -- If this is a duplicate body, no point in analyzing it if Error_Posted (N) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -3212,10 +3178,10 @@ package body Sem_Ch6 is else Spec_Id := Corresponding_Spec (N); - -- The corresponding spec may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged - -- as ignored Ghost. + -- A subprogram body is Ghost when it is stand alone and subject + -- to pragma Ghost or when the corresponding spec is Ghost. Set + -- the mode now to ensure that any nodes generated during analysis + -- and expansion are properly marked as Ghost. Set_Ghost_Mode (N, Spec_Id); end if; @@ -3292,7 +3258,7 @@ package body Sem_Ch6 is if Is_Abstract_Subprogram (Spec_Id) then Error_Msg_N ("an abstract subprogram cannot have a body", N); - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; else @@ -3362,7 +3328,7 @@ package body Sem_Ch6 is if not Conformant and then not Mode_Conformant (Body_Id, Spec_Id) then - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; end if; @@ -3569,7 +3535,7 @@ package body Sem_Ch6 is Analyze_Aspect_Specifications_On_Body_Or_Stub (N); end if; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -4034,7 +4000,7 @@ package body Sem_Ch6 is end if; end; - Restore_Globals; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Subprogram_Body_Helper; --------------------------------- @@ -4139,37 +4105,13 @@ package body Sem_Ch6 is ------------------------------------ procedure Analyze_Subprogram_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - - procedure Restore_Globals; - -- Restore the values of all saved global variables - - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - - -- Local variables - Scop : constant Entity_Id := Current_Scope; Designator : Entity_Id; Is_Completion : Boolean; -- Indicates whether a null procedure declaration is a completion - -- Start of processing for Analyze_Subprogram_Declaration - begin - -- The subprogram declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - -- Null procedures are not allowed in SPARK if Nkind (Specification (N)) = N_Procedure_Specification @@ -4191,7 +4133,6 @@ package body Sem_Ch6 is -- The null procedure acts as a body, nothing further is needed if Is_Completion then - Restore_Globals; return; end if; end if; @@ -4372,8 +4313,6 @@ package body Sem_Ch6 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Designator); end if; - - Restore_Globals; end Analyze_Subprogram_Declaration; -------------------------------------- diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index f39da2c..00efbe0 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -571,7 +571,7 @@ package body Sem_Ch7 is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; Body_Id : Entity_Id; HSS : Node_Id; Last_Spec_Entity : Entity_Id; @@ -637,10 +637,9 @@ package body Sem_Ch7 is end if; end if; - -- The corresponding spec of the package body may be subject to pragma - -- Ghost with policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged as - -- ignored Ghost. + -- A package body is Ghost when the corresponding spec is Ghost. Set + -- the mode now to ensure that any nodes generated during analysis and + -- expansion are properly flagged as ignored Ghost. Set_Ghost_Mode (N, Spec_Id); @@ -942,10 +941,7 @@ package body Sem_Ch7 is end if; end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Package_Body_Helper; ------------------------------ @@ -1021,22 +1017,6 @@ package body Sem_Ch7 is --------------------------------- procedure Analyze_Package_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - - procedure Restore_Globals; - -- Restore the values of all saved global variables - - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - - -- Local variables - Id : constant Node_Id := Defining_Entity (N); Body_Required : Boolean; @@ -1048,8 +1028,6 @@ package body Sem_Ch7 is PF : Boolean; -- True when in the context of a declared pure library unit - -- Start of processing for Analyze_Package_Declaration - begin if Debug_Flag_C then Write_Str ("==> package spec "); @@ -1060,12 +1038,6 @@ package body Sem_Ch7 is Indent; end if; - -- The package declaration may be subject to pragma Ghost with policy - -- Ignore. Set the mode now to ensure that any nodes generated during - -- analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - Generate_Definition (Id); Enter_Name (Id); Set_Ekind (Id, E_Package); @@ -1102,7 +1074,6 @@ package body Sem_Ch7 is -- package Pkg is ... if From_Limited_With (Id) then - Restore_Globals; return; end if; @@ -1163,8 +1134,6 @@ package body Sem_Ch7 is Write_Location (Sloc (N)); Write_Eol; end if; - - Restore_Globals; end Analyze_Package_Declaration; ----------------------------------- @@ -1851,17 +1820,10 @@ package body Sem_Ch7 is -------------------------------------- procedure Analyze_Private_Type_Declaration (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Id : constant Entity_Id := Defining_Identifier (N); PF : constant Boolean := Is_Pure (Enclosing_Lib_Unit_Entity); begin - -- The private type declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - Generate_Definition (Id); Set_Is_Pure (Id, PF); Init_Size_Align (Id); @@ -1885,11 +1847,6 @@ package body Sem_Ch7 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Id); end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Private_Type_Declaration; ---------------------------------- diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ee76eda..a12649e 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -550,17 +550,10 @@ package body Sem_Ch8 is -- there is more than one element in the list. procedure Analyze_Exception_Renaming (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Id : constant Entity_Id := Defining_Entity (N); - Nam : constant Node_Id := Name (N); + Id : constant Entity_Id := Defining_Entity (N); + Nam : constant Node_Id := Name (N); begin - -- The exception renaming declaration may be subject to pragma Ghost - -- with policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged as - -- ignored Ghost. - - Set_Ghost_Mode (N); Check_SPARK_05_Restriction ("exception renaming is not allowed", N); Enter_Name (Id); @@ -595,11 +588,6 @@ package body Sem_Ch8 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Id); end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Exception_Renaming; --------------------------- @@ -669,8 +657,7 @@ package body Sem_Ch8 is (N : Node_Id; K : Entity_Kind) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - New_P : constant Entity_Id := Defining_Entity (N); + New_P : constant Entity_Id := Defining_Entity (N); Old_P : Entity_Id; Inst : Boolean := False; @@ -681,11 +668,6 @@ package body Sem_Ch8 is return; end if; - -- The generic renaming declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); Check_SPARK_05_Restriction ("generic renaming is not allowed", N); Generate_Definition (New_P); @@ -756,11 +738,6 @@ package body Sem_Ch8 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, New_P); end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Generic_Renaming; ----------------------------- @@ -867,10 +844,6 @@ package body Sem_Ch8 is return False; end In_Generic_Scope; - -- Local variables - - GM : constant Ghost_Mode_Type := Ghost_Mode; - -- Start of processing for Analyze_Object_Renaming begin @@ -878,11 +851,6 @@ package body Sem_Ch8 is return; end if; - -- The object renaming declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); Check_SPARK_05_Restriction ("object renaming is not allowed", N); Set_Is_Pure (Id, Is_Pure (Current_Scope)); @@ -1394,11 +1362,6 @@ package body Sem_Ch8 is -- Deal with dimensions Analyze_Dimension (N); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Object_Renaming; ------------------------------ @@ -1406,39 +1369,15 @@ package body Sem_Ch8 is ------------------------------ procedure Analyze_Package_Renaming (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - - procedure Restore_Globals; - -- Restore the values of all saved global variables - - --------------------- - -- Restore_Globals -- - --------------------- - - procedure Restore_Globals is - begin - Ghost_Mode := GM; - end Restore_Globals; - - -- Local variables - New_P : constant Entity_Id := Defining_Entity (N); Old_P : Entity_Id; Spec : Node_Id; - -- Start of processing for Analyze_Package_Renaming - begin if Name (N) = Error then return; end if; - -- The package renaming declaration may be subject to pragma Ghost with - -- policy Ignore. Set the mode now to ensure that any nodes generated - -- during analysis and expansion are properly flagged as ignored Ghost. - - Set_Ghost_Mode (N); - -- Check for Text_IO special unit (we may be renaming a Text_IO child) Check_Text_IO_Special_Unit (Name (N)); @@ -1538,7 +1477,6 @@ package body Sem_Ch8 is -- subtypes again, so they are compatible with types in their class. if not Is_Generic_Instance (Old_P) then - Restore_Globals; return; else Spec := Specification (Unit_Declaration_Node (Old_P)); @@ -1580,8 +1518,6 @@ package body Sem_Ch8 is if Has_Aspects (N) then Analyze_Aspect_Specifications (N, New_P); end if; - - Restore_Globals; end Analyze_Package_Renaming; ------------------------------- @@ -2628,20 +2564,12 @@ package body Sem_Ch8 is -- defaulted formal subprogram when the actual for a related formal -- type is class-wide. - GM : constant Ghost_Mode_Type := Ghost_Mode; - Inst_Node : Node_Id := Empty; + Inst_Node : Node_Id := Empty; New_S : Entity_Id; -- Start of processing for Analyze_Subprogram_Renaming begin - -- The subprogram renaming declaration may be subject to pragma Ghost - -- with policy Ignore. Set the mode now to ensure that any nodes - -- generated during analysis and expansion are properly flagged as - -- ignored Ghost. - - Set_Ghost_Mode (N); - -- We must test for the attribute renaming case before the Analyze -- call because otherwise Sem_Attr will complain that the attribute -- is missing an argument when it is analyzed. @@ -3559,11 +3487,6 @@ package body Sem_Ch8 is Analyze (N); end if; end if; - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; end Analyze_Subprogram_Renaming; ------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c3f7618..04a160b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -390,12 +390,12 @@ package body Sem_Prag is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; - Subp_Decl : constant Node_Id := Find_Related_Subprogram_Or_Body (N); Spec_Id : constant Entity_Id := Corresponding_Spec_Of (Subp_Decl); CCases : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + CCase : Node_Id; Restore_Scope : Boolean := False; @@ -454,10 +454,7 @@ package body Sem_Prag is Error_Msg_N ("wrong syntax for constract cases", N); end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Contract_Cases_In_Decl_Part; ---------------------------------- @@ -1715,10 +1712,11 @@ package body Sem_Prag is (N : Node_Id; Expr_Val : out Boolean) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); - Obj_Id : constant Entity_Id := Entity (Get_Pragma_Arg (Arg1)); Expr : constant Node_Id := Get_Pragma_Arg (Next (Arg1)); + Obj_Id : constant Entity_Id := Entity (Get_Pragma_Arg (Arg1)); + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; begin -- Set the Ghost mode in effect from the pragma. Due to the delayed @@ -1758,10 +1756,7 @@ package body Sem_Prag is end if; end if; - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Analyze_External_Property_In_Decl_Part; --------------------------------- @@ -2264,11 +2259,12 @@ package body Sem_Prag is -------------------------------------------- procedure Analyze_Initial_Condition_In_Decl_Part (N : Node_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; Pack_Decl : constant Node_Id := Find_Related_Package_Or_Body (N); Pack_Id : constant Entity_Id := Defining_Entity (Pack_Decl); Expr : constant Node_Id := Expression (Get_Argument (N, Pack_Id)); + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + begin -- Set the Ghost mode in effect from the pragma. Due to the delayed -- analysis of the pragma, the Ghost mode at point of declaration and @@ -2283,11 +2279,7 @@ package body Sem_Prag is -- is not desired at this point. Preanalyze_Assert_Expression (Expr, Standard_Boolean); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Initial_Condition_In_Decl_Part; -------------------------------------- @@ -10808,18 +10800,12 @@ package body Sem_Prag is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; Expr : Node_Id; New_Args : List_Id; -- Start of processing for Assert begin - -- Ensure that analysis and expansion produce Ghost nodes if the - -- pragma itself is Ghost. - - Set_Ghost_Mode (N); - -- Assert is an Ada 2005 RM-defined pragma if Prag_Id = Pragma_Assert then @@ -10892,11 +10878,6 @@ package body Sem_Prag is Pragma_Argument_Associations => New_Args)); Analyze (N); - - -- Restore the original Ghost mode once analysis and expansion - -- have taken place. - - Ghost_Mode := GM; end Assert; ---------------------- @@ -11551,15 +11532,17 @@ package body Sem_Prag is -- allowed, since they have special meaning for Check_Policy. when Pragma_Check => Check : declare - GM : constant Ghost_Mode_Type := Ghost_Mode; Cname : Name_Id; Eloc : Source_Ptr; Expr : Node_Id; Str : Node_Id; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + begin - -- Ensure that analysis and expansion produce Ghost nodes if the - -- pragma itself is Ghost. + -- Pragma Check is Ghost when it applies to a Ghost entity. Set + -- the mode now to ensure that any nodes generated during analysis + -- and expansion are marked as Ghost. Set_Ghost_Mode (N); @@ -11758,10 +11741,7 @@ package body Sem_Prag is In_Assertion_Expr := In_Assertion_Expr - 1; end if; - -- Restore the original Ghost mode once analysis and expansion - -- have taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Check; -------------------------- @@ -15699,7 +15679,6 @@ package body Sem_Prag is -- [,[Message =>] String_Expression]); when Pragma_Invariant => Invariant : declare - GM : constant Ghost_Mode_Type := Ghost_Mode; Discard : Boolean; Typ : Entity_Id; Type_Id : Node_Id; @@ -15793,11 +15772,6 @@ package body Sem_Prag is if Class_Present (N) then Set_Has_Inheritable_Invariants (Typ); end if; - - -- Restore the original Ghost mode once analysis and expansion - -- have taken place. - - Ghost_Mode := GM; end Invariant; ---------------------- @@ -22450,11 +22424,12 @@ package body Sem_Prag is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; Subp_Decl : constant Node_Id := Find_Related_Subprogram_Or_Body (N); Spec_Id : constant Entity_Id := Corresponding_Spec_Of (Subp_Decl); Expr : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + Restore_Scope : Boolean := False; -- Start of processing for Analyze_Pre_Post_Condition_In_Decl_Part @@ -22500,11 +22475,7 @@ package body Sem_Prag is -- subprogram subject to pragma Inline_Always. Check_Postcondition_Use_In_Inlined_Subprogram (N, Spec_Id); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Analyze_Pre_Post_Condition_In_Decl_Part; ------------------------------------------ diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9492fff..01b912f 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1990,6 +1990,10 @@ package body Sem_Res is return; end Resolution_Failed; + -- Local variables + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- Start of processing for Resolve begin @@ -1997,6 +2001,14 @@ package body Sem_Res is return; end if; + -- A declaration may be subject to pragma Ghost. Set the mode now to + -- ensure that any nodes generated during analysis and expansion are + -- marked as Ghost. + + if Is_Declaration (N) then + Set_Ghost_Mode (N); + end if; + -- Access attribute on remote subprogram cannot be used for a non-remote -- access-to-subprogram type. @@ -2112,6 +2124,7 @@ package body Sem_Res is if Analyzed (N) then Debug_A_Exit ("resolving ", N, " (done, already analyzed)"); Analyze_Dimension (N); + Ghost_Mode := Save_Ghost_Mode; return; -- Any case of Any_Type as the Etype value means that we had a @@ -2119,6 +2132,7 @@ package body Sem_Res is elsif Etype (N) = Any_Type then Debug_A_Exit ("resolving ", N, " (done, Etype = Any_Type)"); + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -2550,6 +2564,7 @@ package body Sem_Res is then Resolve (N, Full_View (Typ)); Set_Etype (N, Typ); + Ghost_Mode := Save_Ghost_Mode; return; -- Check for an aggregate. Sometimes we can get bogus aggregates @@ -2658,6 +2673,7 @@ package body Sem_Res is if Address_Integer_Convert_OK (Typ, Etype (N)) then Rewrite (N, Unchecked_Convert_To (Typ, Relocate_Node (N))); Analyze_And_Resolve (N, Typ); + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -2720,12 +2736,14 @@ package body Sem_Res is end if; Resolution_Failed; + Ghost_Mode := Save_Ghost_Mode; return; -- Test if we have more than one interpretation for the context elsif Ambiguous then Resolution_Failed; + Ghost_Mode := Save_Ghost_Mode; return; -- Only one intepretation @@ -2813,6 +2831,7 @@ package body Sem_Res is -- Rewrite_Renamed_Operator. if Analyzed (N) then + Ghost_Mode := Save_Ghost_Mode; return; end if; end if; @@ -2962,6 +2981,7 @@ package body Sem_Res is if Nkind (N) not in N_Subexpr then Debug_A_Exit ("resolving ", N, " (done)"); Expand (N); + Ghost_Mode := Save_Ghost_Mode; return; end if; @@ -2996,6 +3016,8 @@ package body Sem_Res is Expand (N); end if; + + Ghost_Mode := Save_Ghost_Mode; end Resolve; ------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4903d3f..2e7064b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1314,7 +1314,6 @@ package body Sem_Util is -- Local variables - GM : constant Ghost_Mode_Type := Ghost_Mode; Loc : constant Source_Ptr := Sloc (Typ); Prag : constant Node_Id := Get_Pragma (Typ, Pragma_Default_Initial_Condition); @@ -1324,6 +1323,8 @@ package body Sem_Util is Expr : Node_Id; Stmt : Node_Id; + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + -- Start of processing for Build_Default_Init_Cond_Procedure_Body begin @@ -1341,8 +1342,8 @@ package body Sem_Util is return; end if; - -- Ensure that the analysis and expansion produce Ghost nodes if the - -- type itself is Ghost. + -- The related type may be subject to pragma Ghost. Set the mode now + -- to ensure that the analysis and expansion produce Ghost nodes. Set_Ghost_Mode_From_Entity (Typ); @@ -1412,11 +1413,7 @@ package body Sem_Util is Set_Corresponding_Spec (Body_Decl, Proc_Id); Insert_After_And_Analyze (Declaration_Node (Typ), Body_Decl); - - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Build_Default_Init_Cond_Procedure_Body; -- Local variables @@ -1465,10 +1462,12 @@ package body Sem_Util is --------------------------------------------------- procedure Build_Default_Init_Cond_Procedure_Declaration (Typ : Entity_Id) is - GM : constant Ghost_Mode_Type := Ghost_Mode; - Loc : constant Source_Ptr := Sloc (Typ); - Prag : constant Node_Id := + Loc : constant Source_Ptr := Sloc (Typ); + Prag : constant Node_Id := Get_Pragma (Typ, Pragma_Default_Initial_Condition); + + Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + Proc_Id : Entity_Id; begin @@ -1485,8 +1484,8 @@ package body Sem_Util is return; end if; - -- Ensure that the analysis and expansion produce Ghost nodes if the - -- type itself is Ghost. + -- The related type may be subject to pragma Ghost. Set the mode now to + -- ensure that the analysis and expansion produce Ghost nodes. Set_Ghost_Mode_From_Entity (Typ); @@ -1520,10 +1519,7 @@ package body Sem_Util is Defining_Identifier => Make_Temporary (Loc, 'I'), Parameter_Type => New_Occurrence_Of (Typ, Loc)))))); - -- Restore the original Ghost mode once analysis and expansion have - -- taken place. - - Ghost_Mode := GM; + Ghost_Mode := Save_Ghost_Mode; end Build_Default_Init_Cond_Procedure_Declaration; --------------------------- |