From eaba57fb0a6e78750c116ff716071f6f46a0db2c Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Tue, 2 Aug 2011 08:58:37 +0000 Subject: [PATCH] sem_ch12.adb, [...]: New calling sequence for Analyze_Aspect_Specifications 2011-08-02 Robert Dewar * sem_ch12.adb, sem_ch11.adb: New calling sequence for Analyze_Aspect_Specifications * sem_ch13.adb (Analyze_Aspect_Specifications): New handling for boolean aspects * sem_ch13.ads (Analyze_Aspect_Specifications): New calling sequence * sem_ch3.adb, sem_ch6.adb, sem_ch7.adb, sem_ch9.adb: New calling sequence for Analyze_Aspect_Specifications * sem_prag.adb (Analyze_Pragma): Remove use of Aspect_Cancel entirely * sinfo.ads, sinfo.adb (Aspect_Cancel): Remove, no longer used 2011-08-02 Robert Dewar * freeze.adb (Freeze_Entity): Remove handling of delayed boolean aspects, since these no longer exist. 2011-08-02 Robert Dewar * par-ch13.adb (Aspect_Specifications_Present): Always return false on semicolon, do not try to see if there are aspects following it. * par-ch3.adb (P_Declarative_Items): Better message for unexpected aspect spec. From-SVN: r177095 --- gcc/ada/ChangeLog | 24 ++++++ gcc/ada/freeze.adb | 32 -------- gcc/ada/par-ch13.adb | 30 +++----- gcc/ada/par-ch3.adb | 38 +++++++++- gcc/ada/sem_ch11.adb | 6 +- gcc/ada/sem_ch12.adb | 45 ++++++++---- gcc/ada/sem_ch13.adb | 147 +++++++++++++++++++++++-------------- gcc/ada/sem_ch13.ads | 15 +--- gcc/ada/sem_ch3.adb | 24 ++++-- gcc/ada/sem_ch6.adb | 11 ++- gcc/ada/sem_ch7.adb | 10 ++- gcc/ada/sem_ch9.adb | 25 +++++-- gcc/ada/sem_prag.adb | 170 ++++++++++++------------------------------- gcc/ada/sinfo.adb | 16 ---- gcc/ada/sinfo.ads | 17 ----- 15 files changed, 298 insertions(+), 312 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 886bad566de..02238304889 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2011-08-02 Robert Dewar + + * sem_ch12.adb, sem_ch11.adb: New calling sequence for + Analyze_Aspect_Specifications + * sem_ch13.adb + (Analyze_Aspect_Specifications): New handling for boolean aspects + * sem_ch13.ads (Analyze_Aspect_Specifications): New calling sequence + * sem_ch3.adb, sem_ch6.adb, sem_ch7.adb, sem_ch9.adb: New calling + sequence for Analyze_Aspect_Specifications + * sem_prag.adb (Analyze_Pragma): Remove use of Aspect_Cancel entirely + * sinfo.ads, sinfo.adb (Aspect_Cancel): Remove, no longer used + +2011-08-02 Robert Dewar + + * freeze.adb (Freeze_Entity): Remove handling of delayed boolean + aspects, since these no longer exist. + +2011-08-02 Robert Dewar + + * par-ch13.adb (Aspect_Specifications_Present): Always return false on + semicolon, do not try to see if there are aspects following it. + * par-ch3.adb (P_Declarative_Items): Better message for unexpected + aspect spec. + 2011-08-02 Robert Dewar * sem_ch8.adb, aspects.ads: Minor reformatting. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index c84468536de..98a6571abdf 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2395,10 +2395,6 @@ package body Freeze is -- is required to be delayed to the freeze point, so we evaluate the -- pragma or attribute definition clause in the tree at this point. - -- We also have to deal with the case of Boolean aspects, where the - -- value of the Boolean expression is represented by the setting of - -- the Aspect_Cancel flag on the pragma. - if Has_Delayed_Aspects (E) then declare Ritem : Node_Id; @@ -2415,34 +2411,6 @@ package body Freeze is then Aitem := Aspect_Rep_Item (Ritem); Set_Parent (Aitem, Ritem); - - -- Deal with Boolean case, if no expression, True, otherwise - -- analyze the expression, check it is static, and if its - -- value is False, set Aspect_Cancel for the related pragma. - - if Is_Boolean_Aspect (Ritem) then - declare - Expr : constant Node_Id := Expression (Ritem); - - begin - if Present (Expr) then - Analyze_And_Resolve (Expr, Standard_Boolean); - - if not Is_OK_Static_Expression (Expr) then - Error_Msg_Name_1 := Chars (Identifier (Ritem)); - Error_Msg_N - ("expression for % aspect must be static", - Expr); - - elsif Is_False (Expr_Value (Expr)) then - Set_Aspect_Cancel (Aitem); - end if; - end if; - end; - end if; - - -- Analyze the pragma after possibly setting Aspect_Cancel - Analyze (Aitem); end if; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 95da89c19f9..55dd75fb701 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -46,30 +46,18 @@ package body Ch13 is Result : Boolean; begin - Save_Scan_State (Scan_State); - - -- If we have a semicolon, test for semicolon followed by Aspect - -- Specifications, in which case we decide the semicolon is accidental. - - if Token = Tok_Semicolon then - Scan; -- past semicolon + -- Definitely must have WITH to consider aspect specs to be present - -- The recursive test is set Strict, since we already have one - -- error (the unexpected semicolon), so we will ignore that semicolon - -- only if we absolutely definitely have an aspect specification - -- following it. + -- Note that this means that if we have a semicolon, we immediately + -- return False. There is a case in which this is not optimal, namely + -- something like - if Aspect_Specifications_Present (Strict => True) then - Error_Msg_SP ("|extra "";"" ignored"); - return True; + -- type R is new Integer; + -- with bla bla; - else - Restore_Scan_State (Scan_State); - return False; - end if; - end if; - - -- Definitely must have WITH to consider aspect specs to be present + -- where the semicolon is redundant, but scanning forward for it would + -- be too expensive. Instead we pick up the aspect specifications later + -- as a bogus declaration, and diagnose the semicolon at that point. if Token /= Tok_With then return False; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 4ae03fd213b..89617e61cc1 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -4274,8 +4274,42 @@ package body Ch3 is when Tok_With => Check_Bad_Layout; - Error_Msg_SC ("WITH can only appear in context clause"); - raise Error_Resync; + + if Aspect_Specifications_Present then + + -- If we are after a semicolon, complain that it was ignored. + -- But we don't really ignore it, since we dump the aspects, + -- so we make the error message a normal fatal message which + -- will inhibit semantic analysis anyway). + + if Prev_Token = Tok_Semicolon then + Error_Msg_SP -- CODEFIX + ("extra "";"" ignored"); + + -- If not just past semicolon, just complain that aspects are + -- not allowed at this point. + + else + Error_Msg_SC ("aspect specifications not allowed here"); + end if; + + declare + Dummy_Node : constant Node_Id := + New_Node (N_Package_Specification, Token_Ptr); + pragma Warnings (Off, Dummy_Node); + -- Dummy node to attach aspect specifications to. We will + -- then throw them away. + + begin + P_Aspect_Specifications (Dummy_Node, Semicolon => True); + end; + + -- Here if not aspect specifications case + + else + Error_Msg_SC ("WITH can only appear in context clause"); + raise Error_Resync; + end if; -- BEGIN terminates the scan of a sequence of declarations unless -- there is a missing subprogram body, see section on handling diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 1b0c182713a..35d55599d7c 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -23,7 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Einfo; use Einfo; @@ -65,7 +64,10 @@ package body Sem_Ch11 is Set_Etype (Id, Standard_Exception_Type); Set_Is_Statically_Allocated (Id); Set_Is_Pure (Id, PF); - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Exception_Declaration; -------------------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 697ec53441c..e688485fb59 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1925,7 +1925,9 @@ package body Sem_Ch12 is end if; end if; - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Formal_Object_Declaration; ---------------------------------------------- @@ -2280,8 +2282,10 @@ package body Sem_Ch12 is Set_Scope (Pack_Id, Scope (Formal)); Set_Has_Completion (Pack_Id, True); - <> - Analyze_Aspect_Specifications (N, Pack_Id, Aspect_Specifications (N)); + <> + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Pack_Id); + end if; end Analyze_Formal_Package_Declaration; --------------------------------- @@ -2501,8 +2505,11 @@ package body Sem_Ch12 is end if; end if; - <> - Analyze_Aspect_Specifications (N, Nam, Aspect_Specifications (N)); + <> + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Nam); + end if; + end Analyze_Formal_Subprogram_Declaration; ------------------------------------- @@ -2576,7 +2583,10 @@ package body Sem_Ch12 is end case; Set_Is_Generic_Type (T); - Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, T); + end if; end Analyze_Formal_Type_Declaration; ------------------------------------ @@ -2754,7 +2764,9 @@ package body Sem_Ch12 is end if; end if; - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Generic_Package_Declaration; -------------------------------------------- @@ -2882,7 +2894,10 @@ package body Sem_Ch12 is Generate_Reference_To_Formals (Id); List_Inherited_Pre_Post_Aspects (Id); - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Generic_Subprogram_Declaration; ----------------------------------- @@ -3556,9 +3571,10 @@ package body Sem_Ch12 is Set_Defining_Identifier (N, Act_Decl_Id); end if; - <> - Analyze_Aspect_Specifications - (N, Act_Decl_Id, Aspect_Specifications (N)); + <> + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Act_Decl_Id); + end if; exception when Instantiation_Error => @@ -4336,9 +4352,10 @@ package body Sem_Ch12 is Generic_Renamings_HTable.Reset; end if; - <> - Analyze_Aspect_Specifications - (N, Act_Decl_Id, Aspect_Specifications (N)); + <> + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Act_Decl_Id); + end if; exception when Instantiation_Error => diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ac03bd91ab7..d5d7bfac18b 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -78,16 +78,6 @@ package body Sem_Ch13 is -- inherited from a derived type that is no longer appropriate for the -- new Esize value. In this case, we reset the Alignment to unknown. - procedure Analyze_Non_Null_Aspect_Specifications - (N : Node_Id; - E : Entity_Id; - L : List_Id); - -- This procedure is called to analyze aspect specifications for node N. - -- E is the corresponding entity declared by the declaration node N, and - -- L is the list of aspect specifications for this node. This procedure - -- does the real work, as opposed to Analyze_Aspect_Specifications which - -- is inlined to fast-track the common case. - procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id); -- If Typ has predicates (indicated by Has_Predicates being set for Typ, -- then either there are pragma Invariant entries on the rep chain for the @@ -693,34 +683,13 @@ package body Sem_Ch13 is -- Analyze_Aspect_Specifications -- ----------------------------------- - procedure Analyze_Aspect_Specifications - (N : Node_Id; - E : Entity_Id; - L : List_Id) - is - begin - -- Return if no aspects - - if L = No_List then - return; - end if; - - Analyze_Non_Null_Aspect_Specifications (N, E, L); - end Analyze_Aspect_Specifications; - - -------------------------------------------- - -- Analyze_Non_Null_Aspect_Specifications -- - -------------------------------------------- - - procedure Analyze_Non_Null_Aspect_Specifications - (N : Node_Id; - E : Entity_Id; - L : List_Id) - is + procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is Aspect : Node_Id; Aitem : Node_Id; Ent : Node_Id; + L : constant List_Id := Aspect_Specifications (N); + Ins_Node : Node_Id := N; -- Insert pragmas (except Pre/Post/Invariant/Predicate) after this node @@ -744,10 +713,12 @@ package body Sem_Ch13 is -- Set True if delay is required begin + pragma Assert (Present (L)); + -- Loop through aspects Aspect := First (L); - while Present (Aspect) loop + Aspect_Loop : while Present (Aspect) loop declare Loc : constant Source_Ptr := Sloc (Aspect); Id : constant Node_Id := Identifier (Aspect); @@ -759,6 +730,72 @@ package body Sem_Ch13 is Eloc : Source_Ptr := Sloc (Expr); -- Source location of expression, modified when we split PPC's + procedure Check_False_Aspect_For_Derived_Type; + -- This procedure checks for the case of a false aspect for a + -- derived type, which improperly tries to cancel an aspect + -- inherited from the parent; + + ----------------------------------------- + -- Check_False_Aspect_For_Derived_Type -- + ----------------------------------------- + + procedure Check_False_Aspect_For_Derived_Type is + begin + -- We are only checking derived types + + if not Is_Derived_Type (E) then + return; + end if; + + case A_Id is + when Aspect_Atomic | Aspect_Shared => + if not Is_Atomic (E) then + return; + end if; + + when Aspect_Atomic_Components => + if not Has_Atomic_Components (E) then + return; + end if; + + when Aspect_Discard_Names => + if not Discard_Names (E) then + return; + end if; + + when Aspect_Pack => + if not Is_Packed (E) then + return; + end if; + + when Aspect_Unchecked_Union => + if not Is_Unchecked_Union (E) then + return; + end if; + + when Aspect_Volatile => + if not Is_Volatile (E) then + return; + end if; + + when Aspect_Volatile_Components => + if not Has_Volatile_Components (E) then + return; + end if; + + when others => + return; + end case; + + -- Fall through means we are canceling an inherited aspect + + Error_Msg_Name_1 := Nam; + Error_Msg_NE + ("derived type& inherits aspect%, cannot cancel", Expr, E); + end Check_False_Aspect_For_Derived_Type; + + -- Start of processing for Aspect_Loop + begin -- Skip aspect if already analyzed (not clear if this is needed) @@ -837,14 +874,23 @@ package body Sem_Ch13 is raise Program_Error; -- Aspects taking an optional boolean argument. For all of - -- these we just create a matching pragma and insert it. When - -- the aspect is processed to insert the pragma, the expression - -- is analyzed, setting Cancel_Aspect if the value is False. + -- these we just create a matching pragma and insert it, if + -- the expression is missing or set to True. If the expression + -- is False, we can ignore the aspect with the exception that + -- in the case of a derived type, we must check for an illegal + -- attempt to cancel an inherited aspect. when Boolean_Aspects => Set_Is_Boolean_Aspect (Aspect); - -- Build corresponding pragma node + if Present (Expr) + and then Is_False (Static_Boolean (Expr)) + then + Check_False_Aspect_For_Derived_Type; + goto Continue; + end if; + + -- If True, build corresponding pragma node Aitem := Make_Pragma (Loc, @@ -852,24 +898,13 @@ package body Sem_Ch13 is Pragma_Identifier => Make_Identifier (Sloc (Id), Chars (Id))); - -- No delay required if no expression (nothing to delay!) - - if No (Expr) then - Delay_Required := False; - - -- Expression is present, delay is required. Note that - -- even if the expression is "True", some idiot might - -- define True as False before the freeze point! + -- Never need to delay for boolean aspects - else - Delay_Required := True; - Set_Is_Delayed_Aspect (Aspect); - end if; + Delay_Required := False; -- Library unit aspects. These are boolean aspects, but we - -- always evaluate the expression right away if it is present - -- and just ignore the aspect if the expression is False. We - -- never delay expression evaluation in this case. + -- have to do special things with the insertion, since the + -- pragma belongs inside the declarations of a package. when Library_Unit_Aspects => if Present (Expr) @@ -1220,8 +1255,8 @@ package body Sem_Ch13 is <> Next (Aspect); - end loop; - end Analyze_Non_Null_Aspect_Specifications; + end loop Aspect_Loop; + end Analyze_Aspect_Specifications; ----------------------- -- Analyze_At_Clause -- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index a2726fd44ac..742b88dc7d8 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -36,17 +36,10 @@ package Sem_Ch13 is procedure Analyze_Record_Representation_Clause (N : Node_Id); procedure Analyze_Code_Statement (N : Node_Id); - procedure Analyze_Aspect_Specifications - (N : Node_Id; - E : Entity_Id; - L : List_Id); - -- This procedure is called to analyze aspect specifications for node N. - -- E is the corresponding entity declared by the declaration node N, and - -- L is the list of aspect specifications for this node. If L is No_List, - -- the call is ignored. Note that we can't use a simpler interface of just - -- passing the node N, since the analysis of the node may cause it to be - -- rewritten to a node not permitting aspect specifications. - pragma Inline (Analyze_Aspect_Specifications); + procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id); + -- This procedure is called to analyze aspect specifications for node N. E + -- is the corresponding entity declared by the declaration node N. Callers + -- should check that Has_Aspects (N) is True before calling this routine. procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id); -- Called from Freeze where R is a record entity for which reverse bit diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 04919c004bd..ec1ff216080 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -23,7 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; @@ -2016,7 +2015,10 @@ package body Sem_Ch3 is end if; Set_Original_Record_Component (Id, Id); - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Component_Declaration; -------------------------- @@ -2491,7 +2493,9 @@ package body Sem_Ch3 is Set_Optimize_Alignment_Flags (Def_Id); Check_Eliminated (Def_Id); - Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Def_Id); + end if; end Analyze_Full_Type_Declaration; ---------------------------------- @@ -3704,7 +3708,9 @@ package body Sem_Ch3 is end if; <> - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Object_Declaration; --------------------------- @@ -3943,8 +3949,10 @@ package body Sem_Ch3 is end if; end if; - <> - Analyze_Aspect_Specifications (N, T, Aspect_Specifications (N)); + <> + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, T); + end if; end Analyze_Private_Extension_Declaration; --------------------------------- @@ -4413,7 +4421,9 @@ package body Sem_Ch3 is Check_Eliminated (Id); <> - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Subtype_Declaration; -------------------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 61ce6f60f40..8d0edcc2128 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -23,7 +23,6 @@ -- -- ------------------------------------------------------------------------------ -with Aspects; use Aspects; with Atree; use Atree; with Checks; use Checks; with Debug; use Debug; @@ -263,7 +262,10 @@ package body Sem_Ch6 is Generate_Reference_To_Formals (Designator); Check_Eliminated (Designator); - Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Designator); + end if; end Analyze_Abstract_Subprogram_Declaration; --------------------------------- @@ -3067,7 +3069,10 @@ package body Sem_Ch6 is end if; List_Inherited_Pre_Post_Aspects (Designator); - Analyze_Aspect_Specifications (N, Designator, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Designator); + end if; end Analyze_Subprogram_Declaration; -------------------------------------- diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 255edbe1b94..b36c60069a5 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -28,7 +28,6 @@ -- handling of private and full declarations, and the construction of dispatch -- tables for tagged types. -with Aspects; use Aspects; with Atree; use Atree; with Debug; use Debug; with Einfo; use Einfo; @@ -763,7 +762,9 @@ package body Sem_Ch7 is -- Analye aspect specifications immediately, since we need to recognize -- things like Pure early enough to diagnose violations during analysis. - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; -- Ada 2005 (AI-217): Check if the package has been erroneously named -- in a limited-with clause of its own context. In this case the error @@ -1405,7 +1406,10 @@ package body Sem_Ch7 is New_Private_Type (N, Id, N); Set_Depends_On_Private (Id); - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Private_Type_Declaration; ---------------------------------- diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 9d1a84d4fbd..280c0e91fcb 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -976,7 +976,10 @@ package body Sem_Ch9 is end if; Generate_Reference_To_Formals (Def_Id); - Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Def_Id); + end if; end Analyze_Entry_Declaration; --------------------------------------- @@ -1336,8 +1339,10 @@ package body Sem_Ch9 is end if; end if; - <> - Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N)); + <> + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Def_Id); + end if; end Analyze_Protected_Type_Declaration; --------------------- @@ -1806,7 +1811,10 @@ package body Sem_Ch9 is -- disastrous result. Analyze_Protected_Type_Declaration (N); - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Single_Protected_Declaration; ------------------------------------- @@ -1873,7 +1881,10 @@ package body Sem_Ch9 is -- disastrous result. Analyze_Task_Type_Declaration (N); - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Id); + end if; end Analyze_Single_Task_Declaration; ----------------------- @@ -2152,7 +2163,9 @@ package body Sem_Ch9 is end if; end if; - Analyze_Aspect_Specifications (N, Def_Id, Aspect_Specifications (N)); + if Has_Aspects (N) then + Analyze_Aspect_Specifications (N, Def_Id); + end if; end Analyze_Task_Type_Declaration; ----------------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c42f8bbd999..9b68124181f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -270,13 +270,6 @@ package body Sem_Prag is Pname : constant Name_Id := Pragma_Name (N); Prag_Id : Pragma_Id; - Sense : constant Boolean := not Aspect_Cancel (N); - -- Sense is True if we have the normal case of a pragma that is active - -- and turns the corresponding aspect on. It is false only for the case - -- of a pragma coming from an aspect which is explicitly turned off by - -- using aspect => False. If Sense is False, the effect of the pragma - -- is to turn the corresponding aspect off. - Pragma_Exit : exception; -- This exception is used to exit pragma processing completely. It is -- used when an error is detected, and no further processing is @@ -2461,9 +2454,9 @@ package body Sem_Prag is procedure Set_Atomic (E : Entity_Id) is begin - Set_Is_Atomic (E, Sense); + Set_Is_Atomic (E); - if Sense and then not Has_Alignment_Clause (E) then + if not Has_Alignment_Clause (E) then Set_Alignment (E, Uint_0); end if; end Set_Atomic; @@ -2510,11 +2503,11 @@ package body Sem_Prag is -- Attribute belongs on the base type. If the view of the type is -- currently private, it also belongs on the underlying type. - Set_Is_Volatile (Base_Type (E), Sense); - Set_Is_Volatile (Underlying_Type (E), Sense); + Set_Is_Volatile (Base_Type (E)); + Set_Is_Volatile (Underlying_Type (E)); - Set_Treat_As_Volatile (E, Sense); - Set_Treat_As_Volatile (Underlying_Type (E), Sense); + Set_Treat_As_Volatile (E); + Set_Treat_As_Volatile (Underlying_Type (E)); elsif K = N_Object_Declaration or else (K = N_Component_Declaration @@ -2525,7 +2518,7 @@ package body Sem_Prag is end if; if Prag_Id /= Pragma_Volatile then - Set_Is_Atomic (E, Sense); + Set_Is_Atomic (E); -- If the object declaration has an explicit initialization, a -- temporary may have to be created to hold the expression, to @@ -2533,7 +2526,6 @@ package body Sem_Prag is if Nkind (Parent (E)) = N_Object_Declaration and then Present (Expression (Parent (E))) - and then Sense then Set_Has_Delayed_Freeze (E); end if; @@ -2554,7 +2546,7 @@ package body Sem_Prag is Get_Source_File_Index (Sloc (E)) = Get_Source_File_Index (Sloc (Underlying_Type (Etype (E)))) then - Set_Is_Atomic (Underlying_Type (Etype (E)), Sense); + Set_Is_Atomic (Underlying_Type (Etype (E))); end if; end if; @@ -4155,7 +4147,10 @@ package body Sem_Prag is Subp_Id : Node_Id; Subp : Entity_Id; Applies : Boolean; + Effective : Boolean := False; + -- Set True if inline has some effect, i.e. if there is at least one + -- subprogram set as inlined as a result of the use of the pragma. procedure Make_Inline (Subp : Entity_Id); -- Subp is the defining unit name of the subprogram declaration. Set @@ -4299,11 +4294,6 @@ package body Sem_Prag is -- entity (if declared in the same unit) is inlined. if Is_Subprogram (Subp) then - - if not Sense then - return; - end if; - Inner_Subp := Ultimate_Alias (Inner_Subp); if In_Same_Source_Unit (Subp, Inner_Subp) then @@ -4364,16 +4354,16 @@ package body Sem_Prag is procedure Set_Inline_Flags (Subp : Entity_Id) is begin if Active then - Set_Is_Inlined (Subp, Sense); + Set_Is_Inlined (Subp); end if; if not Has_Pragma_Inline (Subp) then - Set_Has_Pragma_Inline (Subp, Sense); + Set_Has_Pragma_Inline (Subp); Effective := True; end if; if Prag_Id = Pragma_Inline_Always then - Set_Has_Pragma_Inline_Always (Subp, Sense); + Set_Has_Pragma_Inline_Always (Subp); end if; end Set_Inline_Flags; @@ -5846,12 +5836,7 @@ package body Sem_Prag is -- Now set appropriate Ada mode - if Sense then - Ada_Version := Ada_2005; - else - Ada_Version := Ada_Version_Default; - end if; - + Ada_Version := Ada_2005; Ada_Version_Explicit := Ada_2005; end if; end; @@ -5899,12 +5884,7 @@ package body Sem_Prag is -- Now set appropriate Ada mode - if Sense then - Ada_Version := Ada_2012; - else - Ada_Version := Ada_Version_Default; - end if; - + Ada_Version := Ada_2012; Ada_Version_Explicit := Ada_2012; end if; end; @@ -6378,10 +6358,10 @@ package body Sem_Prag is E := Base_Type (E); end if; - Set_Has_Volatile_Components (E, Sense); + Set_Has_Volatile_Components (E); if Prag_Id = Pragma_Atomic_Components then - Set_Has_Atomic_Components (E, Sense); + Set_Has_Atomic_Components (E); end if; else @@ -7398,7 +7378,7 @@ package body Sem_Prag is -- defined in the current declarative part, and recursively -- to any nested scope. - Set_Discard_Names (Current_Scope, Sense); + Set_Discard_Names (Current_Scope); return; else @@ -7419,7 +7399,7 @@ package body Sem_Prag is (Is_Enumeration_Type (E) or else Is_Tagged_Type (E))) or else Ekind (E) = E_Exception then - Set_Discard_Names (E, Sense); + Set_Discard_Names (E); else Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1); @@ -8256,9 +8236,7 @@ package body Sem_Prag is -- subtype), set the flag on that type. if Is_Access_Subprogram_Type (Named_Entity) then - if Sense then - Set_Can_Use_Internal_Rep (Named_Entity, False); - end if; + Set_Can_Use_Internal_Rep (Named_Entity, False); -- Otherwise it's an error (name denotes the wrong sort of entity) @@ -10928,43 +10906,11 @@ package body Sem_Prag is else if not Ignore then - Set_Is_Packed (Base_Type (Typ), Sense); - Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense); + Set_Is_Packed (Base_Type (Typ)); + Set_Has_Non_Standard_Rep (Base_Type (Typ)); end if; - Set_Has_Pragma_Pack (Base_Type (Typ), Sense); - - -- Complete reset action for Aspect_Cancel case - - if Sense = False then - - -- Cancel size unless explicitly set - - if not Has_Size_Clause (Typ) - and then not Has_Object_Size_Clause (Typ) - then - Set_Esize (Typ, Uint_0); - Set_RM_Size (Typ, Uint_0); - Set_Alignment (Typ, Uint_0); - Set_Packed_Array_Type (Typ, Empty); - end if; - - -- Reset component size unless explicitly set - - if not Has_Component_Size_Clause (Typ) then - if Known_Static_Esize (Ctyp) - and then Known_Static_RM_Size (Ctyp) - and then Esize (Ctyp) = RM_Size (Ctyp) - and then Addressable (Esize (Ctyp)) - then - Set_Component_Size - (Base_Type (Typ), Esize (Ctyp)); - else - Set_Component_Size - (Base_Type (Typ), Uint_0); - end if; - end if; - end if; + Set_Has_Pragma_Pack (Base_Type (Typ)); end if; end if; @@ -10985,23 +10931,9 @@ package body Sem_Prag is -- Normal case of pack request active else - Set_Is_Packed (Base_Type (Typ), Sense); - Set_Has_Pragma_Pack (Base_Type (Typ), Sense); - Set_Has_Non_Standard_Rep (Base_Type (Typ), Sense); - - -- Complete reset action for Aspect_Cancel case - - if Sense = False then - - -- Cancel size if not explicitly given - - if not Has_Size_Clause (Typ) - and then not Has_Object_Size_Clause (Typ) - then - Set_Esize (Typ, Uint_0); - Set_Alignment (Typ, Uint_0); - end if; - end if; + Set_Is_Packed (Base_Type (Typ)); + Set_Has_Pragma_Pack (Base_Type (Typ)); + Set_Has_Non_Standard_Rep (Base_Type (Typ)); end if; end if; end if; @@ -11145,13 +11077,11 @@ package body Sem_Prag is Check_Duplicate_Pragma (Ent); - if Sense then - Prag := - Make_Linker_Section_Pragma - (Ent, Sloc (N), ".persistent.bss"); - Insert_After (N, Prag); - Analyze (Prag); - end if; + Prag := + Make_Linker_Section_Pragma + (Ent, Sloc (N), ".persistent.bss"); + Insert_After (N, Prag); + Analyze (Prag); -- Case of use as configuration pragma with no arguments @@ -11310,11 +11240,11 @@ package body Sem_Prag is if Present (Ent) and then not (Pk = N_Package_Specification - and then Present (Generic_Parent (Pa))) + and then Present (Generic_Parent (Pa))) then if not Debug_Flag_U then - Set_Is_Preelaborated (Ent, Sense); - Set_Suppress_Elaboration_Warnings (Ent, Sense); + Set_Is_Preelaborated (Ent); + Set_Suppress_Elaboration_Warnings (Ent); end if; end if; end Preelaborate; @@ -11897,11 +11827,11 @@ package body Sem_Prag is ("pragma% requires a function name", Arg1); end if; - Set_Is_Pure (Def_Id, Sense); + Set_Is_Pure (Def_Id); if not Has_Pragma_Pure_Function (Def_Id) then - Set_Has_Pragma_Pure_Function (Def_Id, Sense); - Effective := Sense; + Set_Has_Pragma_Pure_Function (Def_Id); + Effective := True; end if; exit when From_Aspect_Specification (N); @@ -11909,7 +11839,7 @@ package body Sem_Prag is exit when No (E) or else Scope (E) /= Current_Scope; end loop; - if Sense and then not Effective + if not Effective and then Warn_On_Redundant_Constructs then Error_Msg_NE @@ -12685,7 +12615,7 @@ package body Sem_Prag is Check_Arg_Count (1); Check_Optional_Identifier (Arg1, Name_Entity); Check_Arg_Is_Local_Name (Arg1); - Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1)), Sense); + Set_Debug_Info_Off (Entity (Get_Pragma_Arg (Arg1))); ---------------------------------- -- Suppress_Exception_Locations -- @@ -13129,14 +13059,10 @@ package body Sem_Prag is end loop; end if; - Set_Is_Unchecked_Union (Typ, Sense); - - if Sense then - Set_Convention (Typ, Convention_C); - end if; - - Set_Has_Unchecked_Union (Base_Type (Typ), Sense); - Set_Is_Unchecked_Union (Base_Type (Typ), Sense); + Set_Is_Unchecked_Union (Typ); + Set_Convention (Typ, Convention_C); + Set_Has_Unchecked_Union (Base_Type (Typ)); + Set_Is_Unchecked_Union (Base_Type (Typ)); end Unchecked_Union; ------------------------ @@ -13195,7 +13121,7 @@ package body Sem_Prag is Error_Pragma_Arg ("pragma% requires type", Arg1); end if; - Set_Universal_Aliasing (Implementation_Base_Type (E_Id), Sense); + Set_Universal_Aliasing (Implementation_Base_Type (E_Id)); end Universal_Alias; -------------------- @@ -13263,7 +13189,7 @@ package body Sem_Prag is ("pragma% can only be applied to a variable", Arg_Expr); else - Set_Has_Pragma_Unmodified (Arg_Ent, Sense); + Set_Has_Pragma_Unmodified (Arg_Ent); end if; end if; @@ -13358,7 +13284,7 @@ package body Sem_Prag is Generate_Reference (Arg_Ent, N); end if; - Set_Has_Pragma_Unreferenced (Arg_Ent, Sense); + Set_Has_Pragma_Unreferenced (Arg_Ent); end if; Next (Arg_Node); @@ -13393,7 +13319,7 @@ package body Sem_Prag is ("argument for pragma% must be type or subtype", Arg_Node); end if; - Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr), Sense); + Set_Has_Pragma_Unreferenced_Objects (Entity (Arg_Expr)); Next (Arg_Node); end loop; end Unreferenced_Objects; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 9ac9424063c..571541af26e 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -256,14 +256,6 @@ package body Sinfo is return Node3 (N); end Array_Aggregate; - function Aspect_Cancel - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag11 (N); - end Aspect_Cancel; - function Aspect_Rep_Item (N : Node_Id) return Node_Id is begin @@ -3317,14 +3309,6 @@ package body Sinfo is Set_Node3_With_Parent (N, Val); end Set_Array_Aggregate; - procedure Set_Aspect_Cancel - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag11 (N, Val); - end Set_Aspect_Cancel; - procedure Set_Aspect_Rep_Item (N : Node_Id; Val : Node_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 8d1b51ef6b5..cdf71bc51ca 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -584,14 +584,6 @@ package Sinfo is -- is used for translation of the at end handler into a normal exception -- handler. - -- Aspect_Cancel (Flag11-Sem) - -- Processing of aspect specifications typically generates pragmas and - -- attribute definition clauses that are inserted into the tree after - -- the declaration node to get the desired aspect effect. In the case - -- of Boolean aspects that use "=> False" to cancel the effect of an - -- aspect (i.e. turn if off), the generated pragma has the Aspect_Cancel - -- flag set to indicate that the pragma operates in the opposite sense. - -- Aspect_Rep_Item (Node2-Sem) -- Present in N_Aspect_Specification nodes. Points to the corresponding -- pragma/attribute definition node used to process the aspect. @@ -2085,7 +2077,6 @@ package Sinfo is -- From_Aspect_Specification (Flag13-Sem) -- Is_Delayed_Aspect (Flag14-Sem) -- Import_Interface_Present (Flag16-Sem) - -- Aspect_Cancel (Flag11-Sem) -- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set -- Class_Present (Flag6) set if from Aspect with 'Class -- From_Dynamic_Predicate (Flag7-Sem) Set if Dynamic_Predicate aspect @@ -8076,9 +8067,6 @@ package Sinfo is function Array_Aggregate (N : Node_Id) return Node_Id; -- Node3 - function Aspect_Cancel - (N : Node_Id) return Boolean; -- Flag11 - function Aspect_Rep_Item (N : Node_Id) return Node_Id; -- Node2 @@ -9054,9 +9042,6 @@ package Sinfo is procedure Set_Array_Aggregate (N : Node_Id; Val : Node_Id); -- Node3 - procedure Set_Aspect_Cancel - (N : Node_Id; Val : Boolean := True); -- Flag11 - procedure Set_Aspect_Rep_Item (N : Node_Id; Val : Node_Id); -- Node2 @@ -11709,7 +11694,6 @@ package Sinfo is pragma Inline (Alternatives); pragma Inline (Ancestor_Part); pragma Inline (Array_Aggregate); - pragma Inline (Aspect_Cancel); pragma Inline (Aspect_Rep_Item); pragma Inline (Assignment_OK); pragma Inline (Associated_Node); @@ -12032,7 +12016,6 @@ package Sinfo is pragma Inline (Set_Alternatives); pragma Inline (Set_Ancestor_Part); pragma Inline (Set_Array_Aggregate); - pragma Inline (Set_Aspect_Cancel); pragma Inline (Set_Aspect_Rep_Item); pragma Inline (Set_Assignment_OK); pragma Inline (Set_Associated_Node); -- 2.30.2