diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 55 | ||||
| -rw-r--r-- | gcc/ada/aspects.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/aspects.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 33 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 3 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/repinfo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/s-tarest.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 43 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_mech.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 78 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/snames.adb-tmpl | 12 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 4 |
19 files changed, 205 insertions, 117 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cfa0ea7..ce32cbc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,58 @@ +2013-04-25 Robert Dewar <dewar@adacore.com> + + * gnat_rm.texi: Minor fix to Loop_Variant doc (Loop_Entry allowed). + * s-tarest.adb: Minor reformatting. + +2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> + + * aspects.ads, aspects.adb: Remove aspect Ghost from all relevant + tables. + * einfo.adb: Remove with and use clause for Aspects. + (Is_Ghost_Function): Removed. + (Is_Ghost_Entity): New routine. + (Is_Ghost_Subprogram): New routine. + * einfo.ads: Remove synthesized attribute Is_Ghost_Function + along with its uses in entities. Add synthesized attributes + Is_Ghost_Entity and Is_Ghost_Subprogram along with uses in related + entities. + (Is_Ghost_Function): Removed. + (Is_Ghost_Entity): New routine. + (Is_Ghost_Subprogram): New routine. + * par-prag.adb: Remove pragma Ghost from the processing machinery. + * repinfo.adb (List_Mechanisms): Add a value for convention Ghost. + * sem_attr.adb (Analyze_Access_Attribute): Update the check + for ghost subprograms. + * sem_ch4.adb (Analyze_Call): Update the check for calls + to ghost subprograms. + (Check_Ghost_Function_Call): Removed. + (Check_Ghost_Subprogram_Call): New routine. + * sem_ch6.adb (Check_Convention): Rewritten. + (Check_Overriding_Indicator): Remove the check for overriding + ghost functions. + (Convention_Of): New routine. + * sem_ch12.adb (Preanalyze_Actuals): Update the check for ghost + generic actual subprograms. + * sem_mech.adb (Set_Mechanisms): Add an entry for convention Ghost. + * sem_prag.adb: Remove the value for pragma Ghost from + table Sig_Flags. + (Analyze_Pragma): Remove the processing for pragma Ghost. + (Process_Convention): Emit an error when a ghost + subprogram attempts to override. + (Set_Convention_From_Pragma): Emit an error when a ghost subprogram + attempts to override. + * sinfo.ads: Clarify the usage of field Label_Construct. + * snames.adb-tmpl (Get_Convention_Id): Add an entry for + predefined name Ghost. + (Get_Convention_Name): Add an entry for convention Ghost. + * snames.ads-tmpl: Move predefined name Ghost to the sublist + denoting conventions. Add convention id Ghost. Remove pragma + id Ghost. + +2013-04-25 Ed Schonberg <schonberg@adacore.com> + + * sem_ch7.adb (Swap_Private_Dependents): Do no recurse on child + units if within a generic hierarchy. + 2013-04-24 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch6.adb (Expand_Actuals): Add a predicate check on an diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 401928b..71f7493 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -358,7 +358,6 @@ package body Aspects is Aspect_External_Name => Aspect_External_Name, Aspect_External_Tag => Aspect_External_Tag, Aspect_Favor_Top_Level => Aspect_Favor_Top_Level, - Aspect_Ghost => Aspect_Ghost, Aspect_Global => Aspect_Global, Aspect_Implicit_Dereference => Aspect_Implicit_Dereference, Aspect_Import => Aspect_Import, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index ee8676a..c9560b8 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -160,7 +160,6 @@ package Aspects is Aspect_Discard_Names, Aspect_Export, Aspect_Favor_Top_Level, -- GNAT - Aspect_Ghost, -- GNAT Aspect_Independent, Aspect_Independent_Components, Aspect_Import, @@ -215,7 +214,6 @@ package Aspects is Aspect_Dimension => True, Aspect_Dimension_System => True, Aspect_Favor_Top_Level => True, - Aspect_Ghost => True, Aspect_Global => True, Aspect_Inline_Always => True, Aspect_Invariant => True, @@ -380,7 +378,6 @@ package Aspects is Aspect_External_Tag => Name_External_Tag, Aspect_Export => Name_Export, Aspect_Favor_Top_Level => Name_Favor_Top_Level, - Aspect_Ghost => Name_Ghost, Aspect_Global => Name_Global, Aspect_Implicit_Dereference => Name_Implicit_Dereference, Aspect_Import => Name_Import, diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 96e875e..50735a3 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -32,7 +32,6 @@ pragma Style_Checks (All_Checks); -- Turn off subprogram ordering, not used for this unit -with Aspects; use Aspects; with Atree; use Atree; with Namet; use Namet; with Nlists; use Nlists; @@ -6575,27 +6574,41 @@ package body Einfo is return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer; end Is_Finalizer; - ----------------------- - -- Is_Ghost_Function -- - ----------------------- + --------------------- + -- Is_Ghost_Entity -- + --------------------- - function Is_Ghost_Function (Id : E) return B is + function Is_Ghost_Entity (Id : E) return B is + begin + if Present (Id) and then Ekind (Id) = E_Variable then + return Convention (Id) = Convention_Ghost; + else + return Is_Ghost_Subprogram (Id); + end if; + end Is_Ghost_Entity; + + ------------------------- + -- Is_Ghost_Subprogram -- + ------------------------- + + function Is_Ghost_Subprogram (Id : E) return B is Subp_Id : Entity_Id := Id; begin - if Present (Subp_Id) and then Ekind (Subp_Id) = E_Function then - - -- Handle renamings of functions + if Present (Subp_Id) + and then Ekind_In (Subp_Id, E_Function, E_Procedure) + then + -- Handle subprogram renamings if Present (Alias (Subp_Id)) then Subp_Id := Alias (Subp_Id); end if; - return Has_Aspect (Subp_Id, Aspect_Ghost); + return Convention (Subp_Id) = Convention_Ghost; end if; return False; - end Is_Ghost_Function; + end Is_Ghost_Subprogram; -------------------- -- Is_Input_State -- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 62cdb8e..fd38a1f 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2314,9 +2314,13 @@ package Einfo is -- package, generic function, generic procedure), and False for all -- other entities. --- Is_Ghost_Function (synthesized) --- Applies to all entities. Yields True for a function marked by aspect --- Ghost. +-- Is_Ghost_Entity (synthesized) +-- Applies to all entities. Yields True for a subprogram or a whole +-- object that has convention Ghost. + +-- Is_Ghost_Subprogram (synthesized) +-- Applies to all entities. Yields True for a subprogram that has a Ghost +-- convention. -- Is_Hidden (Flag57) -- Defined in all entities. Set true for all entities declared in the @@ -4219,6 +4223,7 @@ package Einfo is -- floating point subtype created by a floating point type declaration. E_Floating_Point_Subtype, + -- Floating point subtype, created by either a floating point subtype -- or floating point type declaration (in the latter case a floating -- point type is created for the base type, and this is the first @@ -5428,7 +5433,8 @@ package Einfo is -- Address_Clause (synth) -- First_Formal (synth) -- First_Formal_With_Extras (synth) - -- Is_Ghost_Function (synth) (non-generic case only) + -- Is_Ghost_Entity (synth) (non-generic case only) + -- Is_Ghost_Subprogram (synth) (non-generic case only) -- Last_Formal (synth) -- Number_Formals (synth) -- Scope_Depth (synth) @@ -5701,6 +5707,8 @@ package Einfo is -- First_Formal (synth) -- First_Formal_With_Extras (synth) -- Is_Finalizer (synth) + -- Is_Ghost_Entity (synth) (non-generic case only) + -- Is_Ghost_Subprogram (synth) (non-generic case only) -- Last_Formal (synth) -- Number_Formals (synth) @@ -5907,6 +5915,7 @@ package Einfo is -- Treat_As_Volatile (Flag41) -- Address_Clause (synth) -- Alignment_Clause (synth) + -- Is_Ghost_Entity (synth) -- Size_Clause (synth) -- E_Void @@ -6638,7 +6647,8 @@ package Einfo is function Is_Discriminal (Id : E) return B; function Is_Dynamic_Scope (Id : E) return B; function Is_Finalizer (Id : E) return B; - function Is_Ghost_Function (Id : E) return B; + function Is_Ghost_Entity (Id : E) return B; + function Is_Ghost_Subprogram (Id : E) return B; function Is_Input_State (Id : E) return B; function Is_Null_State (Id : E) return B; function Is_Output_State (Id : E) return B; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 6b2574b..05e938f 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -4112,6 +4112,9 @@ to ignore the check (in which case the pragma has no effect on the program), or @code{Disable} in which case the pragma is not even checked for correct syntax. +The @code{Loop_Entry} attribute may be used within the expressions of the +@code{Loop_Variant} pragma to refer to values on entry to the loop. + @node Pragma Machine_Attribute @unnumberedsec Pragma Machine_Attribute @findex Machine_Attribute diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 180bf7c..4910cd7 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1163,7 +1163,6 @@ begin Pragma_Fast_Math | Pragma_Finalize_Storage_Only | Pragma_Float_Representation | - Pragma_Ghost | Pragma_Global | Pragma_Ident | Pragma_Implementation_Defined | diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 9f13f32..1c0222f 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -684,6 +684,8 @@ package body Repinfo is Write_Line ("Intrinsic"); when Convention_Entry => Write_Line ("Entry"); + when Convention_Ghost => + Write_Line ("Ghost"); when Convention_Protected => Write_Line ("Protected"); when Convention_Assembler => diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 399437f..71b116c 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -268,7 +268,7 @@ package body System.Tasking.Restricted.Stages is Save_Occurrence (EO, E); end; - -- Look for a fall-back handler. + -- Look for a fall-back handler -- This package is part of the restricted run time which supports -- neither task hierarchies (No_Task_Hierarchy) nor specific task diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 5ee023b..59c83bb 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -602,9 +602,9 @@ package body Sem_Attr is elsif Aname = Name_Unchecked_Access then Error_Attr ("attribute% cannot be applied to a subprogram", P); - elsif Is_Ghost_Function (Entity (P)) then + elsif Is_Ghost_Subprogram (Entity (P)) then Error_Attr_P - ("prefix of % attribute cannot be a ghost function"); + ("prefix of % attribute cannot be a ghost subprogram"); end if; -- Issue an error if the prefix denotes an eliminated subprogram diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 11ea3ea..5e1da8a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -12401,13 +12401,13 @@ package body Sem_Ch12 is Analyze (Act); end if; - -- Ensure that a ghost function does not act as generic actual + -- Ensure that a ghost subprogram does not act as generic actual if Is_Entity_Name (Act) - and then Is_Ghost_Function (Entity (Act)) + and then Is_Ghost_Subprogram (Entity (Act)) then Error_Msg_N - ("ghost function & cannot act as generic actual", Act); + ("ghost subprogram & cannot act as generic actual", Act); Abandon_Instantiation (Act); elsif Errs /= Serious_Errors_Detected then diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ae69805..eb36597 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -854,10 +854,10 @@ package body Sem_Ch4 is -- Flag indicates whether an interpretation of the prefix is a -- parameterless call that returns an access_to_subprogram. - procedure Check_Ghost_Function_Call; - -- Verify the legality of a call to a ghost function. Such calls can + procedure Check_Ghost_Subprogram_Call; + -- Verify the legality of a call to a ghost subprogram. Such calls can -- appear only in assertion expressions except subtype predicates or - -- from within another ghost function. + -- from within another ghost subprogram. procedure Check_Mixed_Parameter_And_Named_Associations; -- Check that parameter and named associations are not mixed. This is @@ -873,15 +873,15 @@ package body Sem_Ch4 is procedure No_Interpretation; -- Output error message when no valid interpretation exists - ------------------------------- - -- Check_Ghost_Function_Call -- - ------------------------------- + --------------------------------- + -- Check_Ghost_Subprogram_Call -- + --------------------------------- - procedure Check_Ghost_Function_Call is + procedure Check_Ghost_Subprogram_Call is S : Entity_Id; begin - -- The ghost function appears inside an assertion expression + -- The ghost subprogram appears inside an assertion expression if In_Assertion_Expression (N) then return; @@ -890,9 +890,9 @@ package body Sem_Ch4 is S := Current_Scope; while Present (S) and then S /= Standard_Standard loop - -- The call appears inside another ghost function + -- The call appears inside another ghost subprogram - if Is_Ghost_Function (S) then + if Is_Ghost_Subprogram (S) then return; end if; @@ -901,9 +901,9 @@ package body Sem_Ch4 is end if; Error_Msg_N - ("call to ghost function must appear in assertion expression or " - & "another ghost function", N); - end Check_Ghost_Function_Call; + ("call to ghost subprogram must appear in assertion expression or " + & "another ghost subprogram", N); + end Check_Ghost_Subprogram_Call; -------------------------------------------------- -- Check_Mixed_Parameter_And_Named_Associations -- @@ -1275,11 +1275,11 @@ package body Sem_Ch4 is End_Interp_List; end if; - -- A call to a ghost function is allowed only in assertion expressions, - -- excluding subtype predicates, or from within another ghost function. + -- A call to a ghost subprogram is allowed only in assertion expressions + -- excluding subtype predicates or from within another ghost subprogram. - if Is_Ghost_Function (Get_Subprogram_Entity (N)) then - Check_Ghost_Function_Call; + if Is_Ghost_Subprogram (Get_Subprogram_Entity (N)) then + Check_Ghost_Subprogram_Call; end if; end Analyze_Call; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index b9be549..2ca1310 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6292,26 +6292,51 @@ package body Sem_Ch6 is ---------------------- procedure Check_Convention (Op : Entity_Id) is + function Convention_Of (Id : Entity_Id) return Convention_Id; + -- Given an entity, return its convention. The function treats Ghost + -- as convention Ada because the two have the same dynamic semantics. + + ------------------- + -- Convention_Of -- + ------------------- + + function Convention_Of (Id : Entity_Id) return Convention_Id is + Conv : constant Convention_Id := Convention (Id); + begin + if Conv = Convention_Ghost then + return Convention_Ada; + else + return Conv; + end if; + end Convention_Of; + + -- Local variables + + Op_Conv : constant Convention_Id := Convention_Of (Op); + Iface_Conv : Convention_Id; Iface_Elmt : Elmt_Id; Iface_Prim_Elmt : Elmt_Id; Iface_Prim : Entity_Id; + -- Start of processing for Check_Convention + begin Iface_Elmt := First_Elmt (Ifaces_List); while Present (Iface_Elmt) loop Iface_Prim_Elmt := - First_Elmt (Primitive_Operations (Node (Iface_Elmt))); + First_Elmt (Primitive_Operations (Node (Iface_Elmt))); while Present (Iface_Prim_Elmt) loop Iface_Prim := Node (Iface_Prim_Elmt); + Iface_Conv := Convention_Of (Iface_Prim); if Is_Interface_Conformant (Typ, Iface_Prim, Op) - and then Convention (Iface_Prim) /= Convention (Op) + and then Iface_Conv /= Op_Conv then Error_Msg_N ("inconsistent conventions in primitive operations", Typ); Error_Msg_Name_1 := Chars (Op); - Error_Msg_Name_2 := Get_Convention_Name (Convention (Op)); + Error_Msg_Name_2 := Get_Convention_Name (Op_Conv); Error_Msg_Sloc := Sloc (Op); if Comes_From_Source (Op) or else No (Alias (Op)) then @@ -6331,9 +6356,8 @@ package body Sem_Ch6 is end if; Error_Msg_Name_1 := Chars (Op); - Error_Msg_Name_2 := - Get_Convention_Name (Convention (Iface_Prim)); - Error_Msg_Sloc := Sloc (Iface_Prim); + Error_Msg_Name_2 := Get_Convention_Name (Iface_Conv); + Error_Msg_Sloc := Sloc (Iface_Prim); Error_Msg_N ("\\overridden operation % with " & "convention % defined #", Typ); @@ -6829,11 +6853,6 @@ package body Sem_Ch6 is else Set_Overridden_Operation (Subp, Overridden_Subp); end if; - - -- Ensure that a ghost function is not overriding another routine - - elsif Is_Ghost_Function (Subp) then - Error_Msg_N ("ghost function & cannot be overriding", Subp); end if; end if; @@ -12245,6 +12264,7 @@ package body Sem_Ch6 is if Ekind (Designator) /= E_Procedure and then Expander_Active + -- Check of Assertions_Enabled is certainly wrong ??? and then Assertions_Enabled then Func_Typ := Etype (Designator); @@ -12286,6 +12306,7 @@ package body Sem_Ch6 is -- IN OUT args. if Expander_Active and then Assertions_Enabled then + -- Check of Assertions_Enabled is certainly wrong ??? Formal := First_Formal (Designator); while Present (Formal) loop if Ekind (Formal) /= E_In_Parameter diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index b98bf9c..fa80d68 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -1860,10 +1860,14 @@ package body Sem_Ch7 is Set_Is_Potentially_Use_Visible (Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt))); - -- Within a child unit, recurse + -- Within a child unit, recurse, except in generic child + -- unit, which (unfortunately) handle private_dependents + -- separately. if Is_Priv and then Is_Child_Unit (Cunit_Entity (Current_Sem_Unit)) + and then not Is_Empty_Elmt_List (Deps) + and then not Inside_A_Generic then Swap_Private_Dependents (Deps); end if; diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index 924b58c..f71a477b 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -300,12 +300,14 @@ package body Sem_Mech is -- Ada -- --------- - -- Note: all RM defined conventions are treated the same - -- from the point of view of parameter passing mechanism + -- Note: all RM defined conventions are treated the same from + -- the point of view of parameter passing mechanism. Convention + -- Ghost has the same dynamic semantics as convention Ada. when Convention_Ada | Convention_Intrinsic | Convention_Entry | + Convention_Ghost | Convention_Protected | Convention_Stubbed => @@ -486,7 +488,6 @@ package body Sem_Mech is else Set_Mechanism (Formal, By_Reference); end if; - end case; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 18fd9ea..040d7f8 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -4975,9 +4975,16 @@ package body Sem_Prag is and then Present (Overridden_Operation (E)) and then C /= Convention (Overridden_Operation (E)) then - Error_Pragma_Arg - ("cannot change convention for overridden dispatching " - & "operation", Arg1); + -- An attempt to override a subprogram with a ghost subprogram + -- appears as a mismatch in conventions. + + if C = Convention_Ghost then + Error_Msg_N ("ghost subprogram & cannot be overriding", E); + else + Error_Pragma_Arg + ("cannot change convention for overridden dispatching " + & "operation", Arg1); + end if; end if; -- Special checks for Convention_Stdcall @@ -5136,14 +5143,14 @@ package body Sem_Prag is if C = Convention_Ada_Pass_By_Copy then if not Is_First_Subtype (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Copy` only " - & "allowed for types", Arg2); + ("convention `Ada_Pass_By_Copy` only allowed for types", + Arg2); end if; if Is_By_Reference_Type (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Copy` not allowed for " - & "by-reference type", Arg1); + ("convention `Ada_Pass_By_Copy` not allowed for by-reference " + & "type", Arg1); end if; end if; @@ -5152,17 +5159,25 @@ package body Sem_Prag is if C = Convention_Ada_Pass_By_Reference then if not Is_First_Subtype (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Reference` only " - & "allowed for types", Arg2); + ("convention `Ada_Pass_By_Reference` only allowed for types", + Arg2); end if; if Is_By_Copy_Type (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Reference` not allowed for " - & "by-copy type", Arg1); + ("convention `Ada_Pass_By_Reference` not allowed for by-copy " + & "type", Arg1); end if; end if; + -- Ghost special checking + + if Is_Ghost_Subprogram (E) + and then Present (Overridden_Operation (E)) + then + Error_Msg_N ("ghost subprogram & cannot be overriding", E); + end if; + -- Go to renamed subprogram if present, since convention applies to -- the actual renamed entity, not to the renaming entity. If the -- subprogram is inherited, go to parent subprogram. @@ -5299,8 +5314,8 @@ package body Sem_Prag is Generate_Reference (E, Id, 'i'); end if; - -- If the pragma comes from from an aspect, it only applies - -- to the given entity, not its homonyms. + -- If the pragma comes from from an aspect, it only applies to the + -- given entity, not its homonyms. if From_Aspect_Specification (N) then return; @@ -11842,39 +11857,6 @@ package body Sem_Prag is end if; end Float_Representation; - ----------- - -- Ghost -- - ----------- - - -- pragma GHOST (function_LOCAL_NAME); - - when Pragma_Ghost => Ghost : declare - Subp : Node_Id; - Subp_Id : Entity_Id; - - begin - GNAT_Pragma; - S14_Pragma; - Check_Arg_Count (1); - Check_Arg_Is_Local_Name (Arg1); - - -- Ensure the proper placement of the pragma. Ghost must be - -- associated with a subprogram declaration. - - Subp := Parent (Corresponding_Aspect (N)); - - if Nkind (Subp) /= N_Subprogram_Declaration then - Pragma_Misplaced; - return; - end if; - - Subp_Id := Defining_Unit_Name (Specification (Subp)); - - if Ekind (Subp_Id) /= E_Function then - Error_Pragma ("pragma % must be applied to a function"); - end if; - end Ghost; - ------------ -- Global -- ------------ @@ -13120,6 +13102,7 @@ package body Sem_Prag is -- before the body is built (e.g. within an expression function). PDecl := Build_Invariant_Procedure_Declaration (Typ); + Insert_After (N, PDecl); Analyze (PDecl); @@ -17993,7 +17976,7 @@ package body Sem_Prag is Set_Is_Ignored (N, True); when Name_Disable => - Set_Is_Ignored (N, True); + Set_Is_Ignored (N, True); Set_Is_Disabled (N, True); when others => @@ -18277,7 +18260,6 @@ package body Sem_Prag is Pragma_Fast_Math => -1, Pragma_Finalize_Storage_Only => 0, Pragma_Float_Representation => 0, - Pragma_Ghost => 0, Pragma_Global => -1, Pragma_Ident => -1, Pragma_Implementation_Defined => -1, diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 04a64ab..830a2af 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1414,10 +1414,10 @@ package Sinfo is -- Label_Construct (Node2-Sem) -- Used in an N_Implicit_Label_Declaration node. Refers to an N_Label, -- N_Block_Statement or N_Loop_Statement node to which the label - -- declaration applies. This is not currently used in the compiler - -- itself, but it is useful in the implementation of ASIS queries. - -- This field is left empty for the special labels generated as part - -- of expanding raise statements with a local exception handler. + -- declaration applies. This attribute is used both in the compiler and + -- in the implementation of ASIS queries. The field is left empty for the + -- special labels generated as part of expanding raise statements with a + -- local exception handler. -- Library_Unit (Node4-Sem) -- In a stub node, Library_Unit points to the compilation unit node of diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl index 9255395..f79e481 100644 --- a/gcc/ada/snames.adb-tmpl +++ b/gcc/ada/snames.adb-tmpl @@ -155,6 +155,7 @@ package body Snames is when Name_COBOL => return Convention_COBOL; when Name_CPP => return Convention_CPP; when Name_Fortran => return Convention_Fortran; + when Name_Ghost => return Convention_Ghost; when Name_Intrinsic => return Convention_Intrinsic; when Name_Java => return Convention_Java; when Name_Stdcall => return Convention_Stdcall; @@ -192,6 +193,7 @@ package body Snames is when Convention_CPP => return Name_CPP; when Convention_Entry => return Name_Entry; when Convention_Fortran => return Name_Fortran; + when Convention_Ghost => return Name_Ghost; when Convention_Intrinsic => return Name_Intrinsic; when Convention_Java => return Name_Java; when Convention_Protected => return Name_Protected; @@ -293,14 +295,14 @@ package body Snames is exit when Preset_Names (P_Index) = '#'; end loop; - -- Make sure that number of names in standard table is correct. If - -- this check fails, run utility program XSNAMES to construct a new - -- properly matching version of the body. + -- Make sure that number of names in standard table is correct. If this + -- check fails, run utility program XSNAMES to construct a new properly + -- matching version of the body. pragma Assert (Discard_Name = Last_Predefined_Name); - -- Initialize the convention identifiers table with the standard - -- set of synonyms that we recognize for conventions. + -- Initialize the convention identifiers table with the standard set of + -- synonyms that we recognize for conventions. Convention_Identifiers.Init; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 320bf76..2ddae4d 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -499,7 +499,6 @@ package Snames is Name_Export_Valued_Procedure : constant Name_Id := N + $; -- GNAT Name_External : constant Name_Id := N + $; -- GNAT Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT - Name_Ghost : constant Name_Id := N + $; -- GNAT Name_Global : constant Name_Id := N + $; -- GNAT Name_Ident : constant Name_Id := N + $; -- VMS Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT @@ -642,6 +641,7 @@ package Snames is Name_COBOL : constant Name_Id := N + $; Name_CPP : constant Name_Id := N + $; Name_Fortran : constant Name_Id := N + $; + Name_Ghost : constant Name_Id := N + $; Name_Intrinsic : constant Name_Id := N + $; Name_Java : constant Name_Id := N + $; Name_Stdcall : constant Name_Id := N + $; @@ -1630,6 +1630,7 @@ package Snames is Convention_Ada, Convention_Intrinsic, Convention_Entry, + Convention_Ghost, Convention_Protected, Convention_Stubbed, @@ -1795,7 +1796,6 @@ package Snames is Pragma_Export_Valued_Procedure, Pragma_External, Pragma_Finalize_Storage_Only, - Pragma_Ghost, Pragma_Global, Pragma_Ident, Pragma_Implementation_Defined, |