diff options
Diffstat (limited to 'gcc/ada')
39 files changed, 699 insertions, 565 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 85464e3..063d6a7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,118 @@ +2025-08-04 Viljar Indus <indus@adacore.com> + + * contracts.adb: Use Is_Ignored_In_Codegen instead of just + using Is_Ignored. + * exp_ch6.adb: Likewise. + * exp_prag.adb: Likewise. + * exp_util.adb: Likewise. + * frontend.adb: Avoid removal of ignored nodes in GNATProve_Mode. + * gnat1drv.adb: Avoid forcing Assertions_Enabled in GNATProve_Mode. + * lib-writ.adb (Write_With_File_Names): Avoid early exit + with ignored entities in GNATProve_Mode. + * lib-xref.adb: Likewise. + * opt.adb: Remove check for Assertions_Enabled. + * sem_attr.adb: Use Is_Ignored_In_Codegen instead of Is_Ignored. + * sem_ch13.adb: Likewise. Additionally always add predicates in + GNATProve_Mode. + * sem_prag.adb: Likewise. Additionally remove modifications + to applied policies in GNATProve_Mode. + * sem_util.adb (Is_Ignored_In_Codegen): New function that overrides + Is_Ignored in GNATProve_Mode and Codepeer_Mode. + (Is_Ignored_Ghost_Pragma_In_Codegen): Likewise for + Is_Ignored_Ghost_Pragma. + (Is_Ignored_Ghost_Entity_In_Codegen): Likewise for + Is_Ignored_Ghost_Entity. + (Policy_In_List): Remove overriding of policies in GNATProve_Mode. + * sem_util.ads: Add specs for new functions. + * (Predicates_Enabled): Always generate predicates in + GNATProve_Mode. + +2025-08-04 Bob Duff <duff@adacore.com> + + * treepr.adb (Print_Node_Ref): Protect against + Entity (N) being empty before calling + Compile_Time_Known_Value. + +2025-08-04 Viljar Indus <indus@adacore.com> + + * sem_prag.adb (Validate_Compile_Time_Warning_Errors): + Check if the original compile time pragma was replaced and + validate the original node instead. + +2025-08-04 Viljar Indus <indus@adacore.com> + + * sem_prag.adb (Validate_Compile_Time_Warning_Or_Error): + simplify the implementation. + +2025-08-04 Steve Baird <baird@adacore.com> + + * exp_ch6.adb (Apply_Access_Discrims_Accessibility_Check): If the + accessibility level being checked is known statically, then + statically check it against the level of the function being + returned from. + +2025-08-04 Viljar Indus <indus@adacore.com> + + * atree.adb: update references to Ghost_Mode. + * exp_ch3.adb: use a structure type to store all of the existing + ghost mode related state variables. + * exp_disp.adb: Likewise. + * exp_spark.adb: Likewise. + * exp_util.adb: Likewise. + * expander.adb: Likewise. + * freeze.adb: Likewise and replace references to existing ghost + mode variables. + * ghost.adb (Install_Ghost_Region): install the changes of + the region in to the new Ghost_Config structure. + (Restore_Ghost_Region): Use the new Ghost_Config instead. + In general replace all references to the existing ghost mode + variables with the new structure equivalent. + * ghost.ads (Restore_Ghost_Region): update the spec. + * opt.ads (Ghost_Config_Type): A new type that has two of the + previous ghost code related global variables as memembers - + Ghost_Mode and Ignored_Ghost_Region. + (Ghost_Config) New variable to store the previous Ghost_Mode and + Ignored_Ghost_Region info. + * rtsfind.adb: Replace references to existing ghost mode variables. + * sem.adb: Likewise. + * sem_ch12.adb: Likewise. + * sem_ch13.adb: Likewise. + * sem_ch3.adb: Likewise. + * sem_ch5.adb: Likewise. + * sem_ch6.adb: Likewise. + * sem_ch7.adb: Likewise. + * sem_prag.adb: Likewise. + * sem_util.adb: Likewise. + +2025-08-04 Steve Baird <baird@adacore.com> + + * freeze.adb (Freeze_Profile): Do not emit a warning stating that + a formal parameter's size is 8 if the parameter's size is not 8. + +2025-08-04 Viljar Indus <indus@adacore.com> + + * table.adb (Max): Move variable to the body and initialize + it with the same value as in the Init function. + * table.ads (Max): Likewise. + +2025-08-04 Bob Duff <duff@adacore.com> + + * par.adb: Move and rewrite some comments. + (Util): Shared code and comments for dealing with + defining_identifier_lists. + * par-util.adb (Append): Shared code for appending + one identifier onto Defining_Identifiers. + (P_Def_Ids): Shared code for parsing a defining_identifier_list. + Unfortunately, this is not used in all cases, because some of + them mix in sophisticated error recovery, which we do not + modify here. + * par-ch12.adb (P_Formal_Object_Declarations): + Use Defining_Identifiers and related code. + * par-ch3.adb (P_Identifier_Declarations): Likewise. + (P_Known_Discriminant_Part_Opt): Likewise. + (P_Component_Items): Likewise. + * par-ch6.adb (P_Formal_Part): Likewise. + 2025-07-31 Eric Botcazou <ebotcazou@gcc.gnu.org> Revert: diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 20ca189..0ff3d6e 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -1802,12 +1802,12 @@ package body Atree is -- The Ghost node is created within a Ghost region - if Ghost_Mode = Check then + if Ghost_Config.Ghost_Mode = Check then if Nkind (N) in N_Entity then Set_Is_Checked_Ghost_Entity (N); end if; - elsif Ghost_Mode = Ignore then + elsif Ghost_Config.Ghost_Mode = Ignore then if Nkind (N) in N_Entity then Set_Is_Ignored_Ghost_Entity (N); end if; diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 70e9487..7e4e4a2 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -2714,10 +2714,11 @@ package body Contracts is procedure Append_Enabled_Item (Item : Node_Id; List : in out List_Id) is begin - -- Do not chain ignored or disabled pragmas + -- Do not chain ignored or disabled pragmas. Note that disabled + -- pragmas are also considered ignored. if Nkind (Item) = N_Pragma - and then (Is_Ignored (Item) or else Is_Disabled (Item)) + and then Is_Ignored_In_Codegen (Item) then null; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 6cf7c9c..00b3aae 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -9601,8 +9601,7 @@ package body Exp_Ch3 is Def_Id : constant Entity_Id := Entity (N); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Result : Boolean := False; @@ -9956,13 +9955,13 @@ package body Exp_Ch3 is end if; end if; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); return Result; exception when RE_Not_Available => - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); return False; end Freeze_Type; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index eb7422c..e877469 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -921,7 +921,8 @@ package body Exp_Ch6 is -- in accessibility.adb (which can cause the extra formal parameter -- needed for the check(s) generated here to be missing in the case -- of a tagged result type); this is a workaround and can - -- prevent generation of a required check. + -- prevent generation of a required check (or even a required + -- legality check - see "statically too deep" check below). if No (Extra_Accessibility_Of_Result (Func)) then return; @@ -969,6 +970,15 @@ package body Exp_Ch6 is Accessibility_Level (Discr_Exp, Level => Dynamic_Level); Analyze (Discrim_Level); + if Nkind (Discrim_Level) = N_Integer_Literal + and then Intval (Discrim_Level) > Scope_Depth (Func) + then + Error_Msg_N + ("level of type of access discriminant value of " + & "return expression is statically too deep", + Enclosing_Declaration_Or_Statement (Exp)); + end if; + Insert_Action (Exp, Make_Raise_Program_Error (Loc, Condition => @@ -8089,7 +8099,7 @@ package body Exp_Ch6 is Get_Class_Wide_Pragma (Id, Pragma_Precondition); begin - if No (Prag) or else Is_Ignored (Prag) then + if No (Prag) or else Is_Ignored_In_Codegen (Prag) then return; end if; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 619ac40..1c09e20 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -4593,8 +4593,7 @@ package body Exp_Disp is Name_TSD : constant Name_Id := New_External_Name (Tname, 'B', Suffix_Index => -1); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit AI : Elmt_Id; @@ -6526,7 +6525,7 @@ package body Exp_Disp is Register_CG_Node (Typ); <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); return Result; end Make_DT; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 340f2dc..7ec963a 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -134,7 +134,9 @@ package body Exp_Prag is -- Analyze_xxx_In_Decl_Part). The second part of the analysis will -- not happen if the pragma is rewritten. - if Assertion_Expression_Pragma (Prag_Id) and then Is_Ignored (N) then + if Assertion_Expression_Pragma (Prag_Id) + and then Is_Ignored_In_Codegen (N) + then return; -- Rewrite the pragma into a null statement when it is ignored using @@ -143,7 +145,7 @@ package body Exp_Prag is elsif Should_Ignore_Pragma_Sem (N) or else (Prag_Id = Pragma_Default_Scalar_Storage_Order - and then Ignore_Rep_Clauses) + and then Ignore_Rep_Clauses) then Rewrite (N, Make_Null_Statement (Sloc (N))); return; @@ -480,7 +482,7 @@ package body Exp_Prag is begin -- Nothing to do if pragma is ignored - if Is_Ignored (N) then + if Is_Ignored_In_Codegen (N) then return; end if; @@ -1837,7 +1839,7 @@ package body Exp_Prag is -- Do nothing if pragma is not enabled. If pragma is disabled, it has -- already been rewritten as a Null statement. - if Is_Ignored (CCs) then + if Is_Ignored_In_Codegen (CCs) then return; -- Guard against malformed contract cases @@ -2538,7 +2540,7 @@ package body Exp_Prag is -- Nothing to do when the pragma is ignored because its semantics are -- suppressed. - if Is_Ignored (IC_Prag) then + if Is_Ignored_In_Codegen (IC_Prag) then return; -- Nothing to do when the pragma or its argument are illegal because @@ -3001,7 +3003,7 @@ package body Exp_Prag is -- Also do this in CodePeer mode, because the expanded code is too -- complicated for CodePeer to analyse. - if Is_Ignored (N) + if Is_Ignored_In_Codegen (N) or else Chars (Last_Var) = Name_Structural or else CodePeer_Mode then @@ -3391,7 +3393,7 @@ package body Exp_Prag is -- Do nothing if pragma is not present or is disabled. -- Also ignore structural variants for execution. - if Is_Ignored (Prag) + if Is_Ignored_In_Codegen (Prag) or else Chars (Nlists.Last (Choices (Last_Variant))) = Name_Structural then return; diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index a75a507..0f92034 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -1128,8 +1128,7 @@ package body Exp_SPARK is Wrapper_Decl_List : List_Id; Wrapper_Body_List : List_Id := No_List; - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit begin @@ -1253,7 +1252,7 @@ package body Exp_SPARK is end if; end if; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end SPARK_Freeze_Type; end Exp_SPARK; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 5a6fca0..e9ec7b7 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -1903,7 +1903,7 @@ package body Exp_Util is begin -- The DIC pragma is ignored, nothing left to do - if Is_Ignored (DIC_Prag) then + if Is_Ignored_In_Codegen (DIC_Prag) then null; -- Otherwise the DIC expression must be checked at run time. @@ -2311,8 +2311,7 @@ package body Exp_Util is Loc : constant Source_Ptr := Sloc (Typ); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit DIC_Prag : Node_Id; @@ -2558,7 +2557,7 @@ package body Exp_Util is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Build_DIC_Procedure_Body; ------------------------------------- @@ -2575,8 +2574,7 @@ package body Exp_Util is is Loc : constant Source_Ptr := Sloc (Typ); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit DIC_Prag : Node_Id; @@ -2783,7 +2781,7 @@ package body Exp_Util is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Build_DIC_Procedure_Declaration; ------------------------------------ @@ -3237,7 +3235,7 @@ package body Exp_Util is begin -- The invariant is ignored, nothing left to do - if Is_Ignored (Prag) then + if Is_Ignored_In_Codegen (Prag) then null; -- Otherwise the invariant is checked. Build a pragma Check to verify @@ -3709,8 +3707,7 @@ package body Exp_Util is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Dummy : Entity_Id; @@ -4058,7 +4055,7 @@ package body Exp_Util is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Build_Invariant_Procedure_Body; ------------------------------------------- @@ -4075,8 +4072,7 @@ package body Exp_Util is is Loc : constant Source_Ptr := Sloc (Typ); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Proc_Decl : Node_Id; @@ -4292,7 +4288,7 @@ package body Exp_Util is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Build_Invariant_Procedure_Declaration; ------------------------ @@ -10640,8 +10636,7 @@ package body Exp_Util is is Loc : constant Source_Ptr := Sloc (Expr); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Call : Node_Id; @@ -10685,7 +10680,7 @@ package body Exp_Util is Name => New_Occurrence_Of (Func_Id, Loc), Parameter_Associations => Param_Assocs); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); return Call; end Make_Predicate_Call; diff --git a/gcc/ada/expander.adb b/gcc/ada/expander.adb index 3d7b0d7..25f4950 100644 --- a/gcc/ada/expander.adb +++ b/gcc/ada/expander.adb @@ -84,8 +84,7 @@ package body Expander is -- Ghost mode. procedure Expand (N : Node_Id) is - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit begin @@ -559,7 +558,7 @@ package body Expander is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Expand; --------------------------- diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index dbd7cf4..2ebffff 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -2878,8 +2878,7 @@ package body Freeze is is Loc : constant Source_Ptr := Sloc (N); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Atype : Entity_Id; @@ -4813,6 +4812,8 @@ package body Freeze is and then Convention (F_Type) = Convention_Ada and then not Has_Warnings_Off (F_Type) and then not Has_Size_Clause (F_Type) + and then Present (Esize (F_Type)) + and then Esize (F_Type) = 8 then Error_Msg_N ("& is an 8-bit Ada Boolean?x?", Formal); @@ -8358,12 +8359,12 @@ package body Freeze is -- and Per-Object Expressions" will suppress the insertion, and the -- freeze node will be dropped on the floor. - if Saved_GM = Ignore - and then Ghost_Mode /= Ignore - and then Present (Ignored_Ghost_Region) + if Saved_Ghost_Config.Ghost_Mode = Ignore + and then Ghost_Config.Ghost_Mode /= Ignore + and then Present (Ghost_Config.Ignored_Ghost_Region) then Insert_Actions - (Assoc_Node => Ignored_Ghost_Region, + (Assoc_Node => Ghost_Config.Ignored_Ghost_Region, Ins_Actions => Result, Spec_Expr_OK => True); @@ -8371,7 +8372,7 @@ package body Freeze is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); return Result; end Freeze_Entity; diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 564f153..92bc3c6 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -477,7 +477,7 @@ begin -- executable. This action must be performed very late because it -- heavily alters the tree. - if Operating_Mode = Generate_Code or else GNATprove_Mode then + if Operating_Mode = Generate_Code and not CodePeer_Mode then Remove_Ignored_Ghost_Code; end if; diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index 6f648f2..f9c2853 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -447,7 +447,7 @@ package body Ghost is -- The context is Ghost when it appears within a Ghost package or -- subprogram. - if Ghost_Mode > None then + if Ghost_Config.Ghost_Mode > None then return True; -- Routine Expand_Record_Extension creates a parent subtype without @@ -719,7 +719,7 @@ package body Ghost is -- The context is ghost when it appears within a Ghost package or -- subprogram. - if Ghost_Mode > None then + if Ghost_Config.Ghost_Mode > None then return; -- The context is ghost if Formal is explicitly marked as ghost @@ -1130,22 +1130,22 @@ package body Ghost is -- The context is already within an ignored Ghost region. Maintain the -- start of the outermost ignored Ghost region. - if Present (Ignored_Ghost_Region) then + if Present (Ghost_Config.Ignored_Ghost_Region) then null; -- The current region is the outermost ignored Ghost region. Save its -- starting node. elsif Present (N) and then Mode = Ignore then - Ignored_Ghost_Region := N; + Ghost_Config.Ignored_Ghost_Region := N; -- Otherwise the current region is not ignored, nothing to save else - Ignored_Ghost_Region := Empty; + Ghost_Config.Ignored_Ghost_Region := Empty; end if; - Ghost_Mode := Mode; + Ghost_Config.Ghost_Mode := Mode; end Install_Ghost_Region; procedure Install_Ghost_Region (Mode : Name_Id; N : Node_Id) is @@ -1504,10 +1504,10 @@ package body Ghost is -- A body declared within a Ghost region is automatically Ghost -- (SPARK RM 6.9(2)). - elsif Ghost_Mode = Check then + elsif Ghost_Config.Ghost_Mode = Check then Policy := Name_Check; - elsif Ghost_Mode = Ignore then + elsif Ghost_Config.Ghost_Mode = Ignore then Policy := Name_Ignore; -- Inherit the "ghostness" of the previous declaration when the body @@ -1553,10 +1553,10 @@ package body Ghost is -- A completion elaborated in a Ghost region is automatically Ghost -- (SPARK RM 6.9(2)). - if Ghost_Mode = Check then + if Ghost_Config.Ghost_Mode = Check then Policy := Name_Check; - elsif Ghost_Mode = Ignore then + elsif Ghost_Config.Ghost_Mode = Ignore then Policy := Name_Ignore; -- The completion becomes Ghost when its initial declaration is also @@ -1603,10 +1603,10 @@ package body Ghost is -- A declaration elaborated in a Ghost region is automatically Ghost -- (SPARK RM 6.9(2)). - elsif Ghost_Mode = Check then + elsif Ghost_Config.Ghost_Mode = Check then Policy := Name_Check; - elsif Ghost_Mode = Ignore then + elsif Ghost_Config.Ghost_Mode = Ignore then Policy := Name_Ignore; -- A child package or subprogram declaration becomes Ghost when its @@ -1698,10 +1698,10 @@ package body Ghost is -- An instantiation declaration within a Ghost region is automatically -- Ghost (SPARK RM 6.9(2)). - elsif Ghost_Mode = Check then + elsif Ghost_Config.Ghost_Mode = Check then Policy := Name_Check; - elsif Ghost_Mode = Ignore then + elsif Ghost_Config.Ghost_Mode = Ignore then Policy := Name_Ignore; -- Inherit the "ghostness" of the generic unit, but the current Ghost @@ -2018,10 +2018,9 @@ package body Ghost is -- Restore_Ghost_Region -- -------------------------- - procedure Restore_Ghost_Region (Mode : Ghost_Mode_Type; N : Node_Id) is + procedure Restore_Ghost_Region (Config : Ghost_Config_Type) is begin - Ghost_Mode := Mode; - Ignored_Ghost_Region := N; + Ghost_Config := Config; end Restore_Ghost_Region; -------------------- diff --git a/gcc/ada/ghost.ads b/gcc/ada/ghost.ads index 3863e50..62c809c 100644 --- a/gcc/ada/ghost.ads +++ b/gcc/ada/ghost.ads @@ -243,7 +243,7 @@ package Ghost is -- WARNING: this is a separate front end pass, care should be taken to keep -- it optimized. - procedure Restore_Ghost_Region (Mode : Ghost_Mode_Type; N : Node_Id); + procedure Restore_Ghost_Region (Config : Ghost_Config_Type); pragma Inline (Restore_Ghost_Region); -- Restore a Ghost region to a previous state described by mode Mode and -- ignored region start node N. This routine must be used in conjunction diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 52063c8..ee2c329 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -503,11 +503,6 @@ procedure Gnat1drv is Operating_Mode := Check_Semantics; - -- Enable assertions, since they give valuable extra information for - -- formal verification. - - Assertions_Enabled := True; - -- Disable validity checks, since it generates code raising -- exceptions for invalid data, which confuses GNATprove. Invalid -- data is directly detected by GNATprove's flow analysis. diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index b7a7f12..fb7c416 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -905,7 +905,7 @@ package body Lib.Writ is -- Do not generate a with line for an ignored Ghost unit because -- the unit does not have an ALI file. - if Is_Ignored_Ghost_Entity (Cunit_Entity (Unum)) then + if Is_Ignored_Ghost_Entity_In_Codegen (Cunit_Entity (Unum)) then goto Next_With_Line; end if; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 145d314..aa9ae57 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1729,7 +1729,7 @@ package body Lib.Xref is -- entity because neither the entity nor its references will -- appear in the final tree. - if Is_Ignored_Ghost_Entity (Ent) then + if Is_Ignored_Ghost_Entity_In_Codegen (Ent) then goto Orphan_Continue; end if; @@ -2190,7 +2190,7 @@ package body Lib.Xref is -- entity because neither the entity nor its references will -- appear in the final tree. - if Is_Ignored_Ghost_Entity (Ent) then + if Is_Ignored_Ghost_Entity_In_Codegen (Ent) then goto Continue; end if; diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index d2291a9..bd74215 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -204,14 +204,7 @@ package body Opt is SPARK_Mode_Pragma := SPARK_Mode_Pragma_Config; else - -- In GNATprove mode assertions should be always enabled, even - -- when analysing internal units. - - if GNATprove_Mode then - pragma Assert (Assertions_Enabled); - null; - - elsif GNAT_Mode_Config then + if GNAT_Mode_Config then Assertions_Enabled := Assertions_Enabled_Config; else Assertions_Enabled := False; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e595b08..73f9fe8 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -746,9 +746,20 @@ package Opt is -- Possible legal modes that can be set by aspect/pragma Ghost as well as -- value None, which indicates that no such aspect/pragma applies. - Ghost_Mode : Ghost_Mode_Type := None; + type Ghost_Config_Type is record + Ghost_Mode : Ghost_Mode_Type := None; + -- The current Ghost mode in effect + + Ignored_Ghost_Region : Node_Id := Empty; + -- The start of the current ignored Ghost region. This value must always + -- reflect the starting node of the outermost ignored Ghost region. If a + -- nested ignored Ghost region is entered, the value must remain + -- unchanged. + end record; + + Ghost_Config : Ghost_Config_Type; -- GNAT - -- The current Ghost mode in effect + -- All relevant Ghost mode settings Global_Discard_Names : Boolean := False; -- GNAT, GNATBIND @@ -810,12 +821,6 @@ package Opt is -- use of -gnateu, causing subsequent unrecognized switches to result in -- a warning rather than an error. - Ignored_Ghost_Region : Node_Id := Empty; - -- GNAT - -- The start of the current ignored Ghost region. This value must always - -- reflect the starting node of the outermost ignored Ghost region. If a - -- nested ignored Ghost region is entered, the value must remain unchanged. - Implicit_Packing : Boolean := False; -- GNAT -- If set True, then a Size attribute clause on an array is allowed to diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb index b539a29..5fb6f8c 100644 --- a/gcc/ada/par-ch12.adb +++ b/gcc/ada/par-ch12.adb @@ -420,32 +420,17 @@ package body Ch12 is procedure P_Formal_Object_Declarations (Decls : List_Id) is Decl_Node : Node_Id; - Ident : Pos; Not_Null_Present : Boolean := False; - Num_Idents : Pos; Scan_State : Saved_Scan_State; - Idents : array (Pos range 1 .. 4096) of Entity_Id; - -- This array holds the list of defining identifiers. The upper bound - -- of 4096 is intended to be essentially infinite, and we do not even - -- bother to check for it being exceeded. + Def_Ids : Defining_Identifiers; + Ident : Pos; begin - Idents (1) := P_Defining_Identifier (C_Comma_Colon); - Num_Idents := 1; - while Comma_Present loop - Num_Idents := Num_Idents + 1; - Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); - end loop; - + P_Def_Ids (Def_Ids); T_Colon; - -- If there are multiple identifiers, we repeatedly scan the - -- type and initialization expression information by resetting - -- the scan pointer (so that we get completely separate trees - -- for each occurrence). - - if Num_Idents > 1 then + if Def_Ids.Num_Idents > 1 then Save_Scan_State (Scan_State); end if; @@ -454,7 +439,7 @@ package body Ch12 is Ident := 1; Ident_Loop : loop Decl_Node := New_Node (N_Formal_Object_Declaration, Token_Ptr); - Set_Defining_Identifier (Decl_Node, Idents (Ident)); + Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (Ident)); P_Mode (Decl_Node); Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-423) @@ -488,13 +473,13 @@ package body Ch12 is Set_Prev_Ids (Decl_Node, True); end if; - if Ident < Num_Idents then + if Ident < Def_Ids.Num_Idents then Set_More_Ids (Decl_Node, True); end if; Append (Decl_Node, Decls); - exit Ident_Loop when Ident = Num_Idents; + exit Ident_Loop when Ident = Def_Ids.Num_Idents; Ident := Ident + 1; Restore_Scan_State (Scan_State); end loop Ident_Loop; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index fe727d7..a685812 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -1302,19 +1302,13 @@ package body Ch3 is Ident_Sloc : Source_Ptr; Scan_State : Saved_Scan_State; List_OK : Boolean := True; - Ident : Nat; Init_Expr : Node_Id; Init_Loc : Source_Ptr; Con_Loc : Source_Ptr; Not_Null_Present : Boolean := False; - Idents : array (Int range 1 .. 4096) of Entity_Id; - -- Used to save identifiers in the identifier list. The upper bound - -- of 4096 is expected to be infinite in practice, and we do not even - -- bother to check if this upper bound is exceeded. - - Num_Idents : Nat := 1; - -- Number of identifiers stored in Idents + Def_Ids : Defining_Identifiers; + Ident : Pos; function Identifier_Starts_Statement return Boolean; -- Called with Token being an identifier that might start a declaration @@ -1389,10 +1383,9 @@ package body Ch3 is procedure No_List is begin - if Num_Idents > 1 then + if Def_Ids.Num_Idents > 1 then Error_Msg_N - ("identifier list not allowed for RENAMES", - Idents (2)); + ("identifier list not allowed for RENAMES", Def_Ids.Idents (2)); end if; List_OK := False; @@ -1443,7 +1436,7 @@ package body Ch3 is Ident_Sloc := Token_Ptr; Save_Scan_State (Scan_State); -- at first identifier - Idents (1) := P_Defining_Identifier (C_Comma_Colon); + Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon)); -- If we have a colon after the identifier, then we can assume that -- this is in fact a valid identifier declaration and can steam ahead. @@ -1455,8 +1448,7 @@ package body Ch3 is elsif Token = Tok_Comma then while Comma_Present loop - Num_Idents := Num_Idents + 1; - Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); + Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon)); end loop; Save_Scan_State (Scan_State); -- at colon @@ -1510,7 +1502,7 @@ package body Ch3 is Decl_Node := New_Node (N_Object_Renaming_Declaration, Ident_Sloc); Set_Name (Decl_Node, P_Name); - Set_Defining_Identifier (Decl_Node, Idents (1)); + Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (1)); P_Aspect_Specifications (Decl_Node, Semicolon => False); @@ -1917,7 +1909,7 @@ package body Ch3 is end if; end if; - Set_Defining_Identifier (Decl_Node, Idents (Ident)); + Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (Ident)); P_Aspect_Specifications (Decl_Node, Semicolon => False); -- Allow initialization expression to follow aspects (note that in @@ -1945,17 +1937,17 @@ package body Ch3 is T_Semicolon; if List_OK then - if Ident < Num_Idents then - Set_More_Ids (Decl_Node, True); - end if; - if Ident > 1 then Set_Prev_Ids (Decl_Node, True); end if; + + if Ident < Def_Ids.Num_Idents then + Set_More_Ids (Decl_Node, True); + end if; end if; Append (Decl_Node, Decls); - exit Ident_Loop when Ident = Num_Idents; + exit Ident_Loop when Ident = Def_Ids.Num_Idents; Restore_Scan_State (Scan_State); T_Colon; Ident := Ident + 1; @@ -3191,14 +3183,7 @@ package body Ch3 is Specification_List : List_Id; Ident_Sloc : Source_Ptr; Scan_State : Saved_Scan_State; - Num_Idents : Nat; Not_Null_Present : Boolean; - Ident : Nat; - - Idents : array (Int range 1 .. 4096) of Entity_Id; - -- This array holds the list of defining identifiers. The upper bound - -- of 4096 is intended to be essentially infinite, and we do not even - -- bother to check for it being exceeded. begin if Token = Tok_Left_Paren then @@ -3207,97 +3192,91 @@ package body Ch3 is P_Pragmas_Misplaced; Specification_Loop : loop + declare + Def_Ids : Defining_Identifiers; + Ident : Pos; + begin + Ident_Sloc := Token_Ptr; + P_Def_Ids (Def_Ids); - Ident_Sloc := Token_Ptr; - Idents (1) := P_Defining_Identifier (C_Comma_Colon); - Num_Idents := 1; - - while Comma_Present loop - Num_Idents := Num_Idents + 1; - Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); - end loop; - - -- If there are multiple identifiers, we repeatedly scan the - -- type and initialization expression information by resetting - -- the scan pointer (so that we get completely separate trees - -- for each occurrence). + if Def_Ids.Num_Idents > 1 then + Save_Scan_State (Scan_State); + end if; - if Num_Idents > 1 then - Save_Scan_State (Scan_State); - end if; + T_Colon; - T_Colon; + -- Loop through defining identifiers in list - -- Loop through defining identifiers in list + Ident := 1; + Ident_Loop : loop + Specification_Node := + New_Node (N_Discriminant_Specification, Ident_Sloc); + Set_Defining_Identifier + (Specification_Node, Def_Ids.Idents (Ident)); + Not_Null_Present := -- Ada 2005 (AI-231, AI-447) + P_Null_Exclusion (Allow_Anonymous_In_95 => True); - Ident := 1; - Ident_Loop : loop - Specification_Node := - New_Node (N_Discriminant_Specification, Ident_Sloc); - Set_Defining_Identifier (Specification_Node, Idents (Ident)); - Not_Null_Present := -- Ada 2005 (AI-231, AI-447) - P_Null_Exclusion (Allow_Anonymous_In_95 => True); + if Token = Tok_Access then + if Ada_Version = Ada_83 then + Error_Msg_SC + ("(Ada 83) access discriminant not allowed!"); + end if; - if Token = Tok_Access then - if Ada_Version = Ada_83 then - Error_Msg_SC - ("(Ada 83) access discriminant not allowed!"); - end if; + Set_Discriminant_Type + (Specification_Node, + P_Access_Definition (Not_Null_Present)); - Set_Discriminant_Type - (Specification_Node, - P_Access_Definition (Not_Null_Present)); + -- Catch ouf-of-order keywords - -- Catch ouf-of-order keywords + elsif Token = Tok_Constant then + Scan; - elsif Token = Tok_Constant then - Scan; + if Token = Tok_Access then + Error_Msg_SC -- CODEFIX + ("ACCESS must come before CONSTANT"); + Set_Discriminant_Type + (Specification_Node, + P_Access_Definition (Not_Null_Present)); - if Token = Tok_Access then - Error_Msg_SC -- CODEFIX - ("ACCESS must come before CONSTANT"); - Set_Discriminant_Type - (Specification_Node, - P_Access_Definition (Not_Null_Present)); + else + Error_Msg_SC ("misplaced CONSTANT"); + end if; else - Error_Msg_SC ("misplaced CONSTANT"); + Set_Discriminant_Type + (Specification_Node, P_Subtype_Mark); + No_Constraint; + Set_Null_Exclusion_Present -- Ada 2005 (AI-231) + (Specification_Node, Not_Null_Present); end if; - else - Set_Discriminant_Type - (Specification_Node, P_Subtype_Mark); - No_Constraint; - Set_Null_Exclusion_Present -- Ada 2005 (AI-231) - (Specification_Node, Not_Null_Present); - end if; - - Set_Expression - (Specification_Node, Init_Expr_Opt (True)); + Set_Expression + (Specification_Node, Init_Expr_Opt (True)); - if Token = Tok_With then - P_Aspect_Specifications - (Specification_Node, Semicolon => False); - end if; + if Token = Tok_With then + P_Aspect_Specifications + (Specification_Node, Semicolon => False); + end if; - if Ident > 1 then - Set_Prev_Ids (Specification_Node, True); - end if; + if Ident > 1 then + Set_Prev_Ids (Specification_Node, True); + end if; - if Ident < Num_Idents then - Set_More_Ids (Specification_Node, True); - end if; + if Ident < Def_Ids.Num_Idents then + Set_More_Ids (Specification_Node, True); + end if; - Append (Specification_Node, Specification_List); - exit Ident_Loop when Ident = Num_Idents; - Ident := Ident + 1; - Restore_Scan_State (Scan_State); - T_Colon; - end loop Ident_Loop; + Append (Specification_Node, Specification_List); + exit Ident_Loop when Ident = Def_Ids.Num_Idents; + Ident := Ident + 1; + Restore_Scan_State (Scan_State); + T_Colon; + end loop Ident_Loop; - exit Specification_Loop when Token /= Tok_Semicolon; - Scan; -- past ; - P_Pragmas_Misplaced; + exit Specification_Loop when Token /= Tok_Semicolon; + Scan; -- past ; + P_Pragmas_Misplaced; + end; end loop Specification_Loop; T_Right_Paren; @@ -3770,14 +3749,10 @@ package body Ch3 is Decl_Node : Node_Id := Empty; -- initialize to prevent warning Scan_State : Saved_Scan_State; Not_Null_Present : Boolean := False; - Num_Idents : Nat; - Ident : Nat; Ident_Sloc : Source_Ptr; - Idents : array (Int range 1 .. 4096) of Entity_Id; - -- This array holds the list of defining identifiers. The upper bound - -- of 4096 is intended to be essentially infinite, and we do not even - -- bother to check for it being exceeded. + Def_Ids : Defining_Identifiers; + Ident : Pos; begin if Token /= Tok_Identifier then @@ -3788,20 +3763,9 @@ package body Ch3 is Ident_Sloc := Token_Ptr; Check_Bad_Layout; - Idents (1) := P_Defining_Identifier (C_Comma_Colon); - Num_Idents := 1; - - while Comma_Present loop - Num_Idents := Num_Idents + 1; - Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); - end loop; - - -- If there are multiple identifiers, we repeatedly scan the - -- type and initialization expression information by resetting - -- the scan pointer (so that we get completely separate trees - -- for each occurrence). + P_Def_Ids (Def_Ids); - if Num_Idents > 1 then + if Def_Ids.Num_Idents > 1 then Save_Scan_State (Scan_State); end if; @@ -3817,7 +3781,7 @@ package body Ch3 is begin Decl_Node := New_Node (N_Component_Declaration, Ident_Sloc); - Set_Defining_Identifier (Decl_Node, Idents (Ident)); + Set_Defining_Identifier (Decl_Node, Def_Ids.Idents (Ident)); if Token = Tok_Constant then Error_Msg_SC ("constant component not permitted"); @@ -3876,7 +3840,7 @@ package body Ch3 is Set_Prev_Ids (Decl_Node, True); end if; - if Ident < Num_Idents then + if Ident < Def_Ids.Num_Idents then Set_More_Ids (Decl_Node, True); end if; @@ -3890,7 +3854,7 @@ package body Ch3 is end if; end; - exit Ident_Loop when Ident = Num_Idents; + exit Ident_Loop when Ident = Def_Ids.Num_Idents; Ident := Ident + 1; Restore_Scan_State (Scan_State); T_Colon; diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb index 0f7765b..2465108 100644 --- a/gcc/ada/par-ch6.adb +++ b/gcc/ada/par-ch6.adb @@ -1384,20 +1384,16 @@ package body Ch6 is Specification_List : List_Id; Specification_Node : Node_Id; Scan_State : Saved_Scan_State; - Num_Idents : Nat; - Ident : Nat; Ident_Sloc : Source_Ptr; Not_Null_Present : Boolean := False; Not_Null_Sloc : Source_Ptr; - Idents : array (Int range 1 .. 4096) of Entity_Id; - -- This array holds the list of defining identifiers. The upper bound - -- of 4096 is intended to be essentially infinite, and we do not even - -- bother to check for it being exceeded. - begin Specification_List := New_List; Specification_Loop : loop + declare + Def_Ids : Defining_Identifiers; + Ident : Pos; begin if Token = Tok_Pragma then Error_Msg_SC ("pragma not allowed in formal part"); @@ -1406,8 +1402,7 @@ package body Ch6 is Ignore (Tok_Left_Paren); Ident_Sloc := Token_Ptr; - Idents (1) := P_Defining_Identifier (C_Comma_Colon); - Num_Idents := 1; + Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon)); Ident_Loop : loop exit Ident_Loop when Token = Tok_Colon; @@ -1457,8 +1452,7 @@ package body Ch6 is -- Here if a comma is present, or to be assumed T_Comma; - Num_Idents := Num_Idents + 1; - Idents (Num_Idents) := P_Defining_Identifier (C_Comma_Colon); + Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon)); end loop Ident_Loop; -- Fall through the loop on encountering a colon, or deciding @@ -1466,12 +1460,7 @@ package body Ch6 is T_Colon; - -- If there are multiple identifiers, we repeatedly scan the - -- type and initialization expression information by resetting - -- the scan pointer (so that we get completely separate trees - -- for each occurrence). - - if Num_Idents > 1 then + if Def_Ids.Num_Idents > 1 then Save_Scan_State (Scan_State); end if; @@ -1482,7 +1471,8 @@ package body Ch6 is Ident_List_Loop : loop Specification_Node := New_Node (N_Parameter_Specification, Ident_Sloc); - Set_Defining_Identifier (Specification_Node, Idents (Ident)); + Set_Defining_Identifier + (Specification_Node, Def_Ids.Idents (Ident)); -- Scan possible ALIASED for Ada 2012 (AI-142) @@ -1574,12 +1564,12 @@ package body Ch6 is Set_Prev_Ids (Specification_Node, True); end if; - if Ident < Num_Idents then + if Ident < Def_Ids.Num_Idents then Set_More_Ids (Specification_Node, True); end if; Append (Specification_Node, Specification_List); - exit Ident_List_Loop when Ident = Num_Idents; + exit Ident_List_Loop when Ident = Def_Ids.Num_Idents; Ident := Ident + 1; Restore_Scan_State (Scan_State); end loop Ident_List_Loop; diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 78a76b3..6a6afd0 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -34,6 +34,22 @@ with GNAT.Spelling_Checker; use GNAT.Spelling_Checker; separate (Par) package body Util is + ------------ + -- Append -- + ------------ + + procedure Append + (Def_Ids : in out Defining_Identifiers; Def_Id : Entity_Id) + is + begin + if Def_Ids.Num_Idents >= Defining_Identifiers_Array'Last then + raise Program_Error; + end if; + + Def_Ids.Num_Idents := Def_Ids.Num_Idents + 1; + Def_Ids.Idents (Def_Ids.Num_Idents) := Def_Id; + end Append; + --------------------- -- Bad_Spelling_Of -- --------------------- @@ -691,6 +707,19 @@ package body Util is end if; end No_Constraint; + --------------- + -- P_Def_Ids -- + --------------- + + procedure P_Def_Ids (Def_Ids : out Defining_Identifiers) is + pragma Assert (Def_Ids.Num_Idents = 0); + begin + loop + Append (Def_Ids, P_Defining_Identifier (C_Comma_Colon)); + exit when not Comma_Present; + end loop; + end P_Def_Ids; + --------------------- -- Pop_Scope_Stack -- --------------------- diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index e11ec7e..99bbed2 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -227,6 +227,69 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- that there is a missing body, but it seems more reasonable to let the -- later semantic checking discover this. + -------------------------------------------- + -- Handling IS Used in Place of Semicolon -- + -------------------------------------------- + + -- This is a somewhat trickier situation, and we can't catch it in all + -- cases, but we do our best to detect common situations resulting from + -- a "cut and paste" operation which forgets to change the IS to semicolon. + -- Consider the following example: + + -- package body X is + -- procedure A; + -- procedure B is -- Error: IS should be semicolon + -- procedure C; + -- ... + -- procedure D is + -- begin + -- ... + -- end; + -- begin + -- ... + -- end; -- end of B? + + -- The trouble is that the section of text from PROCEDURE B through the + -- END; marked "-- end of B?" constitutes a valid procedure body, and the + -- danger is that we find out far too late that something is wrong. + + -- We have two approaches to helping to control this situation. First we + -- make every attempt to avoid swallowing the last END; if we can be sure + -- that some error will result from doing so. In particular, we won't + -- accept the END; unless it is exactly correct (in particular it must not + -- have incorrect name tokens), and we won't accept it if it is immediately + -- followed by end of file, WITH or SEPARATE (tokens that unmistakeably + -- signal the start of a compilation unit, and which therefore allow us to + -- reserve the END; for the outer level.) For more details on this aspect + -- of the handling, see package Par.Endh. + + -- If we can avoid eating up the END; then the result in the absence of + -- any additional steps would be to post a missing END referring back to + -- the subprogram with the bogus IS. Similarly, if the enclosing package + -- has no BEGIN, then the result is a missing BEGIN message, which again + -- refers back to the subprogram header. + + -- Such an error message is not too bad, but it's not ideal, because + -- the declarations following the IS have been absorbed into the wrong + -- scope. In the above case, this could result for example in a bogus + -- complaint that the body of D was missing from the package. + + -- To catch at least some of these cases, we take the following additional + -- steps. First, a subprogram body is marked as having a suspicious IS if + -- the declaration line is followed by a line that starts with a symbol + -- that can start a declaration in the same column, or to the left of the + -- column in which the FUNCTION or PROCEDURE starts (normal style is to + -- indent any declarations that really belong a subprogram). If such a + -- subprogram encounters a missing BEGIN or missing END, then we decide + -- that the IS should have been a semicolon, and the subprogram body node + -- is marked (by setting the Bad_Is_Detected flag true. Note that we do + -- not do this for library level procedures, only for nested procedures, + -- since for library level procedures, we must have a body. + + -- The processing for a declarative part checks to see if the last + -- declaration scanned is marked in this way, and if it is, the tree + -- is modified to reflect the IS being interpreted as a semicolon. + ---------------------------------------------------- -- Handling of Reserved Words Used as Identifiers -- ---------------------------------------------------- @@ -294,71 +357,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is C_Vertical_Bar_Arrow); -- Consider as identifier if followed by | or => - -------------------------------------------- - -- Handling IS Used in Place of Semicolon -- - -------------------------------------------- - - -- This is a somewhat trickier situation, and we can't catch it in all - -- cases, but we do our best to detect common situations resulting from - -- a "cut and paste" operation which forgets to change the IS to semicolon. - -- Consider the following example: - - -- package body X is - -- procedure A; - -- procedure B is - -- procedure C; - -- ... - -- procedure D is - -- begin - -- ... - -- end; - -- begin - -- ... - -- end; - - -- The trouble is that the section of text from PROCEDURE B through END; - -- constitutes a valid procedure body, and the danger is that we find out - -- far too late that something is wrong (indeed most compilers will behave - -- uncomfortably on the above example). - - -- We have two approaches to helping to control this situation. First we - -- make every attempt to avoid swallowing the last END; if we can be sure - -- that some error will result from doing so. In particular, we won't - -- accept the END; unless it is exactly correct (in particular it must not - -- have incorrect name tokens), and we won't accept it if it is immediately - -- followed by end of file, WITH or SEPARATE (all tokens that unmistakeably - -- signal the start of a compilation unit, and which therefore allow us to - -- reserve the END; for the outer level.) For more details on this aspect - -- of the handling, see package Par.Endh. - - -- If we can avoid eating up the END; then the result in the absence of - -- any additional steps would be to post a missing END referring back to - -- the subprogram with the bogus IS. Similarly, if the enclosing package - -- has no BEGIN, then the result is a missing BEGIN message, which again - -- refers back to the subprogram header. - - -- Such an error message is not too bad (it's already a big improvement - -- over what many parsers do), but it's not ideal, because the declarations - -- following the IS have been absorbed into the wrong scope. In the above - -- case, this could result for example in a bogus complaint that the body - -- of D was missing from the package. - - -- To catch at least some of these cases, we take the following additional - -- steps. First, a subprogram body is marked as having a suspicious IS if - -- the declaration line is followed by a line which starts with a symbol - -- that can start a declaration in the same column, or to the left of the - -- column in which the FUNCTION or PROCEDURE starts (normal style is to - -- indent any declarations which really belong a subprogram). If such a - -- subprogram encounters a missing BEGIN or missing END, then we decide - -- that the IS should have been a semicolon, and the subprogram body node - -- is marked (by setting the Bad_Is_Detected flag true. Note that we do - -- not do this for library level procedures, only for nested procedures, - -- since for library level procedures, we must have a body. - - -- The processing for a declarative part checks to see if the last - -- declaration scanned is marked in this way, and if it is, the tree - -- is modified to reflect the IS being interpreted as a semicolon. - --------------------------------------------------- -- Parser Type Definitions and Control Variables -- --------------------------------------------------- @@ -1450,6 +1448,47 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- the Node N (which is a Defining_Identifier node with the Chars field -- set) is a renaming of an entity in package Standard. + ----------------------------------- + -- Multiple defining identifiers -- + ----------------------------------- + + -- RM-3.3.1(7) says: + -- + -- Any declaration that includes a defining_identifier_list with + -- more than one defining_identifier is equivalent to a series of + -- declarations each containing one defining_identifier from the list, + -- with the rest of the text of the declaration copied for each + -- declaration in the series, in the same order as the list. + -- + -- We parse such declarations by first calling P_Def_Ids (see below). + -- Then, if there are multiple identifiers, we repeatedly scan the + -- type and initialization expression information by resetting the + -- scan pointer (so that we get completely separate trees for each + -- occurrence). + + -- Defining_Identifiers is a sequence of identifiers parsed by + -- P_Def_Ids. Idents holds the identifiers, and Num_Idents + -- points to the last-used array elements. The upper bound + -- is intended to be essentially infinite, so we don't bother + -- giving a good error message when it is exceeded -- we + -- simply raise an exception. + + type Defining_Identifiers_Array is + array (Pos range 1 .. 4096) of Entity_Id; + + type Defining_Identifiers is record + Num_Idents : Nat := 0; + Idents : Defining_Identifiers_Array; + end record; + + procedure Append + (Def_Ids : in out Defining_Identifiers; Def_Id : Entity_Id); + -- Append one defining identifier onto Def_Ids. + + procedure P_Def_Ids (Def_Ids : out Defining_Identifiers); + -- Parse a defining_identifier_list, appending the identifiers + -- onto Def_Ids, which should be initially empty. + end Util; -------------- diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 86713ff..f47aacc 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -1030,8 +1030,7 @@ package body Rtsfind is U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id); Priv_Par : constant Elist_Id := New_Elmt_List; Lib_Unit : Node_Id; - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; Saved_SM : constant SPARK_Mode_Type := SPARK_Mode; @@ -1099,7 +1098,7 @@ package body Rtsfind is procedure Restore_SPARK_Context is begin Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Restore_SPARK_Mode (Saved_SM, Saved_SMP); end Restore_SPARK_Context; @@ -1289,7 +1288,7 @@ package body Rtsfind is declare LibUnit : constant Node_Id := Unit (Cunit (U.Unum)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; + Saved_GM : constant Ghost_Mode_Type := Ghost_Config.Ghost_Mode; Clause : Node_Id; Withn : Node_Id; @@ -1308,13 +1307,13 @@ package body Rtsfind is -- later, after ignored ghost code is converted to a null -- statement. - Ghost_Mode := None; + Ghost_Config.Ghost_Mode := None; Withn := Make_With_Clause (Standard_Location, Name => Make_Unit_Name (U, Defining_Unit_Name (Specification (LibUnit)))); - Ghost_Mode := Saved_GM; + Ghost_Config.Ghost_Mode := Saved_GM; Set_Corresponding_Spec (Withn, U.Entity); Set_First_Name (Withn); @@ -1627,7 +1626,9 @@ package body Rtsfind is -- is pulled within an ignored Ghost context because all this code will -- disappear. - if U_Id = System_Secondary_Stack and then Ghost_Mode /= Ignore then + if U_Id = System_Secondary_Stack + and then Ghost_Config.Ghost_Mode /= Ignore + then Sec_Stack_Used := True; end if; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index e168d62..944ece1 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -104,8 +104,7 @@ package body Sem is -- Ghost mode. procedure Analyze (N : Node_Id) is - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit begin @@ -842,7 +841,7 @@ package body Sem is Expand_SPARK_Potential_Renaming (N); end if; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze; -- Version with check(s) suppressed @@ -1440,8 +1439,7 @@ package body Sem is -- the Ghost mode. procedure Do_Analyze is - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; -- Save Ghost and SPARK mode-related data to restore on exit @@ -1489,7 +1487,7 @@ package body Sem is Style_Max_Line_Length := Saved_ML; Style_Check_Max_Line_Length := Saved_CML; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; end Do_Analyze; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f38380c..78b6318 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5092,7 +5092,7 @@ package body Sem_Attr is -- early transformation also avoids the generation of a useless loop -- entry constant. - if Present (Encl_Prag) and then Is_Ignored (Encl_Prag) then + if Present (Encl_Prag) and then Is_Ignored_In_Codegen (Encl_Prag) then Rewrite (N, Relocate_Node (P)); Preanalyze_And_Resolve (N); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index b5c9e88..1ba76dc 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4900,8 +4900,7 @@ package body Sem_Ch12 is Loc : constant Source_Ptr := Sloc (N); Is_Abbrev : constant Boolean := Is_Abbreviated_Instance (Defining_Entity (N)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; Saved_SM : constant SPARK_Mode_Type := SPARK_Mode; @@ -5680,7 +5679,7 @@ package body Sem_Ch12 is end if; Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Restore_SPARK_Mode (Saved_SM, Saved_SMP); Style_Check := Saved_Style_Check; @@ -5695,7 +5694,7 @@ package body Sem_Ch12 is end if; Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Restore_SPARK_Mode (Saved_SM, Saved_SMP); Style_Check := Saved_Style_Check; end Analyze_Package_Instantiation; @@ -6340,8 +6339,7 @@ package body Sem_Ch12 is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; Saved_SM : constant SPARK_Mode_Type := SPARK_Mode; @@ -6736,7 +6734,7 @@ package body Sem_Ch12 is end if; Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Restore_SPARK_Mode (Saved_SM, Saved_SMP); exception @@ -6750,7 +6748,7 @@ package body Sem_Ch12 is end if; Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Restore_SPARK_Mode (Saved_SM, Saved_SMP); end Analyze_Subprogram_Instantiation; @@ -12874,8 +12872,7 @@ package body Sem_Ch12 is -- the package body. Saved_CS : constant Config_Switches_Type := Save_Config_Switches; - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; Saved_LSST : constant Suppress_Stack_Entry_Ptr := @@ -13405,7 +13402,7 @@ package body Sem_Ch12 is Expander_Mode_Restore; Restore_Config_Switches (Saved_CS); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Restore_SPARK_Mode (Saved_SM, Saved_SMP); Restore_Warnings (Saved_Warn); end Instantiate_Package_Body; @@ -13436,8 +13433,7 @@ package body Sem_Ch12 is -- the subprogram body. Saved_CS : constant Config_Switches_Type := Save_Config_Switches; - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; Saved_LSST : constant Suppress_Stack_Entry_Ptr := @@ -13740,7 +13736,7 @@ package body Sem_Ch12 is Expander_Mode_Restore; Restore_Config_Switches (Saved_CS); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); Restore_SPARK_Mode (Saved_SM, Saved_SMP); Restore_Warnings (Saved_Warn); end Instantiate_Subprogram_Body; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index b7ada50..31735e4 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -4799,7 +4799,7 @@ package body Sem_Ch13 is and then not Is_Ignored_Ghost_Entity (E) then if A_Id = Aspect_Pre then - if Is_Ignored (Aspect) then + if Is_Ignored_In_Codegen (Aspect) then Set_Ignored_Class_Preconditions (E, New_Copy_Tree (Expr)); else @@ -4813,7 +4813,7 @@ package body Sem_Ch13 is elsif No (Class_Postconditions (E)) and then No (Ignored_Class_Postconditions (E)) then - if Is_Ignored (Aspect) then + if Is_Ignored_In_Codegen (Aspect) then Set_Ignored_Class_Postconditions (E, New_Copy_Tree (Expr)); else @@ -10282,8 +10282,7 @@ package body Sem_Ch13 is procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id) is Loc : constant Source_Ptr := Sloc (Typ); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Expr : Node_Id; @@ -10449,7 +10448,7 @@ package body Sem_Ch13 is -- which is needed to generate the corresponding predicate -- function. - if Is_Ignored_Ghost_Pragma (Prag) then + if Is_Ignored_Ghost_Pragma_In_Codegen (Prag) then Add_Condition (New_Occurrence_Of (Standard_True, Sloc (Prag))); else @@ -10490,7 +10489,8 @@ package body Sem_Ch13 is -- "and"-in the Arg2 condition to evolving expression - if not Is_Ignored_Ghost_Pragma (Prag) then + if not Is_Ignored_Ghost_Pragma_In_Codegen (Prag) + then Add_Condition (Arg2_Copy); end if; end; @@ -11090,7 +11090,7 @@ package body Sem_Ch13 is end; end if; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); if Restore_Scope then Pop_Scope; @@ -11110,8 +11110,7 @@ package body Sem_Ch13 is is Loc : constant Source_Ptr := Sloc (Typ); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Func_Decl : Node_Id; @@ -11192,7 +11191,7 @@ package body Sem_Ch13 is Insert_After (Parent (Typ), Func_Decl); Analyze (Func_Decl); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); return Func_Decl; end Build_Predicate_Function_Declaration; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3726169..9f69e4f 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4386,8 +4386,7 @@ package body Sem_Ch3 is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Prev_Entity : Entity_Id := Empty; @@ -5475,7 +5474,7 @@ package body Sem_Ch3 is Check_No_Hidden_State (Id); end if; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Object_Declaration; --------------------------- @@ -21707,8 +21706,7 @@ package body Sem_Ch3 is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Full_Indic : Node_Id; @@ -22401,7 +22399,7 @@ package body Sem_Ch3 is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Process_Full_View; ----------------------------------- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 0661e64..9e4936b 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -385,8 +385,7 @@ package body Sem_Ch5 is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit T1 : Entity_Id; @@ -1193,7 +1192,7 @@ package body Sem_Ch5 is Analyze_Dimension (N); <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); -- If the right-hand side contains target names, expansion has been -- disabled to prevent expansion that might move target names out of @@ -2108,7 +2107,7 @@ package body Sem_Ch5 is -- A label declared within a Ghost region becomes Ghost (SPARK RM -- 6.9(2)). - if Ghost_Mode > None then + if Ghost_Config.Ghost_Mode > None then Set_Is_Ghost_Entity (Id); end if; end Analyze_Implicit_Label_Declaration; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 709f625..b7ddc4b 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1372,8 +1372,7 @@ package body Sem_Ch6 is Loc : constant Source_Ptr := Sloc (N); Spec : constant Node_Id := Specification (N); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; -- Save the Ghost and SPARK mode-related data to restore on exit @@ -1529,7 +1528,7 @@ package body Sem_Ch6 is <<Leave>> Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Null_Procedure; ----------------------------- @@ -1624,8 +1623,7 @@ package body Sem_Ch6 is Loc : constant Source_Ptr := Sloc (N); P : constant Node_Id := Name (N); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Actual : Node_Id; @@ -1890,7 +1888,7 @@ package body Sem_Ch6 is end if; <<Leave>> - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Procedure_Call; ------------------------------ @@ -3608,8 +3606,7 @@ package body Sem_Ch6 is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_EA : constant Boolean := Expander_Active; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; @@ -3836,7 +3833,7 @@ package body Sem_Ch6 is -- user entities, as internally generated entitities might still need -- to be expanded (e.g. those generated for types). - if Present (Ignored_Ghost_Region) + if Present (Ghost_Config.Ignored_Ghost_Region) and then Comes_From_Source (Body_Id) then Expander_Active := False; @@ -5022,12 +5019,12 @@ package body Sem_Ch6 is end if; <<Leave>> - if Present (Ignored_Ghost_Region) then + if Present (Ghost_Config.Ignored_Ghost_Region) then Expander_Active := Saved_EA; end if; Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Subprogram_Body_Helper; ------------------------------------ diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index c2e60aa..d28bafb 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -714,8 +714,7 @@ package body Sem_Ch7 is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; Saved_EA : constant Boolean := Expander_Active; Saved_ISMP : constant Boolean := Ignore_SPARK_Mode_Pragmas_In_Instance; @@ -836,7 +835,7 @@ package body Sem_Ch7 is -- user entities, as internally generated entities might still need -- to be expanded (e.g. those generated for types). - if Present (Ignored_Ghost_Region) + if Present (Ghost_Config.Ignored_Ghost_Region) and then Comes_From_Source (Body_Id) then Expander_Active := False; @@ -1149,12 +1148,12 @@ package body Sem_Ch7 is end if; end if; - if Present (Ignored_Ghost_Region) then + if Present (Ghost_Config.Ignored_Ghost_Region) then Expander_Active := Saved_EA; end if; Ignore_SPARK_Mode_Pragmas_In_Instance := Saved_ISMP; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Package_Body_Helper; --------------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2717c38..4fd5b65 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -436,8 +436,7 @@ package body Sem_Prag is Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Errors : Nat; @@ -492,7 +491,7 @@ package body Sem_Prag is End_Scope; end if; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end if; Set_Is_Analyzed_Pragma (N); @@ -607,8 +606,7 @@ package body Sem_Prag is CCases : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit CCase : Node_Id; @@ -695,7 +693,7 @@ package body Sem_Prag is Set_Is_Analyzed_Pragma (N); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Contract_Cases_In_Decl_Part; ---------------------------------- @@ -2464,8 +2462,7 @@ package body Sem_Prag is Exceptional_Contracts : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Exceptional_Contract : Node_Id; @@ -2556,7 +2553,7 @@ package body Sem_Prag is Set_Is_Analyzed_Pragma (N); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Exceptional_Cases_In_Decl_Part; ------------------------------------- @@ -2772,8 +2769,7 @@ package body Sem_Prag is Exit_Contracts : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Exit_Contract : Node_Id; @@ -2863,7 +2859,7 @@ package body Sem_Prag is Set_Is_Analyzed_Pragma (N); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Exit_Cases_In_Decl_Part; -------------------------------------------- @@ -3688,8 +3684,7 @@ package body Sem_Prag is Pack_Id : constant Entity_Id := Defining_Entity (Pack_Decl); Expr : constant Node_Id := Expression (Get_Argument (N, Pack_Id)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit begin @@ -3713,7 +3708,7 @@ package body Sem_Prag is Preanalyze_And_Resolve (Expr, Standard_Boolean); Set_Is_Analyzed_Pragma (N); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Initial_Condition_In_Decl_Part; -------------------------------------- @@ -5766,7 +5761,7 @@ package body Sem_Prag is begin if Pname = Name_Pre_Class then - if Is_Ignored (N) then + if Is_Ignored_In_Codegen (N) then Set_Ignored_Class_Preconditions (Subp_Id, New_Copy_Tree (Expr)); else @@ -5774,7 +5769,7 @@ package body Sem_Prag is end if; else - if Is_Ignored (N) then + if Is_Ignored_In_Codegen (N) then Set_Ignored_Class_Postconditions (Subp_Id, New_Copy_Tree (Expr)); else @@ -12987,7 +12982,9 @@ package body Sem_Prag is -- An abstract state declared within a Ghost region becomes -- Ghost (SPARK RM 6.9(2)). - if Ghost_Mode > None or else Is_Ghost_Entity (Pack_Id) then + if Ghost_Config.Ghost_Mode > None + or else Is_Ghost_Entity (Pack_Id) + then Set_Is_Ghost_Entity (State_Id); end if; @@ -14302,7 +14299,7 @@ package body Sem_Prag is -- cannot occur within a Ghost subprogram or package -- (SPARK RM 6.9(16)). - if Ghost_Mode > None then + if Ghost_Config.Ghost_Mode > None then Error_Pragma ("pragma % cannot appear within ghost subprogram or " & "package"); @@ -14871,25 +14868,15 @@ package body Sem_Prag is Set_Is_Ignored (N, False); else - -- In CodePeer mode and GNATprove mode, we need to - -- consider all assertions, unless they are disabled, - -- because transformations of the AST may depend on - -- assertions being checked. + Set_Is_Checked (N, False); + Set_Is_Ignored (N, True); - if CodePeer_Mode or GNATprove_Mode then - Set_Is_Checked (N, True); - Set_Is_Ignored (N, False); - else - Set_Is_Checked (N, False); - Set_Is_Ignored (N, True); - end if; end if; end Handle_Dynamic_Predicate_Check; -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Cname : Name_Id; @@ -15047,7 +15034,7 @@ package body Sem_Prag is -- False at compile time, and we do not want to delete this -- warning when we delete the if statement. - if Expander_Active and Is_Ignored (N) then + if Expander_Active and Is_Ignored_In_Codegen (N) then Eloc := Sloc (Expr); Rewrite (N, @@ -15100,7 +15087,7 @@ package body Sem_Prag is In_Assertion_Expr := In_Assertion_Expr - 1; end if; - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Check; -------------------------- @@ -16246,10 +16233,10 @@ package body Sem_Prag is Cond := New_Occurrence_Of (Boolean_Literals - (Expander_Active and then not Is_Ignored (N)), + (Expander_Active and then not Is_Ignored_In_Codegen (N)), Loc); - if not Is_Ignored (N) then + if not Is_Ignored_In_Codegen (N) then Set_SCO_Pragma_Enabled (Loc); end if; @@ -18720,7 +18707,7 @@ package body Sem_Prag is -- region (SPARK RM 6.9(6)). if Is_False (Expr_Value (Expr)) - and then Ghost_Mode > None + and then Ghost_Config.Ghost_Mode > None then Error_Pragma ("pragma % with value False cannot appear in enabled " @@ -28323,8 +28310,7 @@ package body Sem_Prag is Expr : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Errors : Nat; @@ -28417,7 +28403,7 @@ package body Sem_Prag is Check_Postcondition_Use_In_Inlined_Subprogram (N, Spec_Id); Set_Is_Analyzed_Pragma (N); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Pre_Post_Condition_In_Decl_Part; --------------------------------------- @@ -28437,8 +28423,7 @@ package body Sem_Prag is Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Errors : Nat; @@ -28561,7 +28546,7 @@ package body Sem_Prag is Check_Postcondition_Use_In_Inlined_Subprogram (N, Spec_Id); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end if; Set_Is_Analyzed_Pragma (N); @@ -31803,8 +31788,7 @@ package body Sem_Prag is Variants : constant Node_Id := Expression (Get_Argument (N, Spec_Id)); - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit Variant : Node_Id; @@ -31899,7 +31883,7 @@ package body Sem_Prag is Set_Is_Analyzed_Pragma (N); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Analyze_Subprogram_Variant_In_Decl_Part; ------------------------------------ @@ -32195,20 +32179,8 @@ package body Sem_Prag is when Name_Ignore | Name_Off => - -- In CodePeer mode and GNATprove mode, we need to - -- consider all assertions, unless they are disabled. - -- Force Is_Checked on ignored assertions, in particular - -- because transformations of the AST may depend on - -- assertions being checked (e.g. the translation of - -- attribute 'Loop_Entry). - - if CodePeer_Mode or GNATprove_Mode then - Set_Is_Checked (N, True); - Set_Is_Ignored (N, False); - else - Set_Is_Checked (N, False); - Set_Is_Ignored (N, True); - end if; + Set_Is_Checked (N, False); + Set_Is_Ignored (N, True); when Name_Check | Name_On @@ -34270,113 +34242,123 @@ package body Sem_Prag is (N : Node_Id; Eloc : Source_Ptr) is - Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); - Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1); - Arg2 : constant Node_Id := Next (Arg1); + Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N)); + Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1); + Prag_Id : constant Pragma_Id := Get_Pragma_Id (N); - Pname : constant Name_Id := Pragma_Name_Unmapped (N); - Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pname); + procedure Emit_Compile_Time_Message (Msg_Arg : Node_Id); + -- Emit the pragma a as diagnostic message. New_Line characters are + -- considered separators for those messages where the following lines + -- are considered as continuation messages for the same diagnostic. - begin - Analyze_And_Resolve (Arg1x, Standard_Boolean); + ------------------------------- + -- Emit_Compile_Time_Message -- + ------------------------------- - if Compile_Time_Known_Value (Arg1x) then - if Is_True (Expr_Value (Arg1x)) then + procedure Emit_Compile_Time_Message (Msg_Arg : Node_Id) is + -- We have already verified that the Msg_Arg is a static + -- string expression. Its string value must be retrieved + -- explicitly if it is a declared constant, otherwise it has + -- been constant-folded previously. + + Cent : constant Entity_Id := Cunit_Entity (Current_Sem_Unit); + Str : constant String_Id := + Strval (Expr_Value_S (Get_Pragma_Arg (Msg_Arg))); + Str_Len : constant Nat := String_Length (Str); + + Force : constant Boolean := + Prag_Id = Pragma_Compile_Time_Warning + and then Is_Spec_Name (Unit_Name (Current_Sem_Unit)) + and then (Ekind (Cent) /= E_Package + or else not In_Private_Part (Cent)); + -- Set True if this is the warning case, and we are in the + -- visible part of a package spec, or in a subprogram spec, + -- in which case we want to force the client to see the + -- warning, even though it is not in the main unit. + + Msg_Ctrl : Bounded_String (6); + -- Control characters for the message. + -- The longest value contains 6 characters: "\<<~!!" + + C : Character; + CC : Char_Code; + Cont : Boolean; + Ptr : Nat; - -- We have already verified that the second argument is a static - -- string expression. Its string value must be retrieved - -- explicitly if it is a declared constant, otherwise it has - -- been constant-folded previously. + begin + -- Loop through segments of message separated by line feeds. + -- We output these segments as separate messages with + -- continuation marks for all but the first. - declare - Cent : constant Entity_Id := Cunit_Entity (Current_Sem_Unit); - Str : constant String_Id := - Strval (Expr_Value_S (Get_Pragma_Arg (Arg2))); - Str_Len : constant Nat := String_Length (Str); - - Force : constant Boolean := - Prag_Id = Pragma_Compile_Time_Warning - and then Is_Spec_Name (Unit_Name (Current_Sem_Unit)) - and then (Ekind (Cent) /= E_Package - or else not In_Private_Part (Cent)); - -- Set True if this is the warning case, and we are in the - -- visible part of a package spec, or in a subprogram spec, - -- in which case we want to force the client to see the - -- warning, even though it is not in the main unit. - - C : Character; - CC : Char_Code; - Cont : Boolean; - Ptr : Nat; + Cont := False; + Ptr := 1; + loop + Error_Msg_Strlen := 0; + Msg_Ctrl.Length := 0; - begin - -- Loop through segments of message separated by line feeds. - -- We output these segments as separate messages with - -- continuation marks for all but the first. + -- Loop to copy characters from argument to error message + -- string buffer. - Cont := False; - Ptr := 1; - loop - Error_Msg_Strlen := 0; + loop + exit when Ptr > Str_Len; + CC := Get_String_Char (Str, Ptr); + Ptr := Ptr + 1; - -- Loop to copy characters from argument to error message - -- string buffer. + -- Ignore wide chars ??? else store character - loop - exit when Ptr > Str_Len; - CC := Get_String_Char (Str, Ptr); - Ptr := Ptr + 1; + if In_Character_Range (CC) then + C := Get_Character (CC); + exit when C = ASCII.LF; + Error_Msg_Strlen := Error_Msg_Strlen + 1; + Error_Msg_String (Error_Msg_Strlen) := C; + end if; + end loop; - -- Ignore wide chars ??? else store character + -- Here with one line ready to go - if In_Character_Range (CC) then - C := Get_Character (CC); - exit when C = ASCII.LF; - Error_Msg_Strlen := Error_Msg_Strlen + 1; - Error_Msg_String (Error_Msg_Strlen) := C; - end if; - end loop; + Error_Msg_Warn := Prag_Id = Pragma_Compile_Time_Warning; - -- Here with one line ready to go + if Cont then + Append (Msg_Ctrl, "\"); + end if; - Error_Msg_Warn := Prag_Id = Pragma_Compile_Time_Warning; + Append (Msg_Ctrl, "<<~"); - -- If this is a warning in a spec, then we want clients - -- to see the warning, so mark the message with the - -- special sequence !! to force the warning. In the case - -- of a package spec, we do not force this if we are in - -- the private part of the spec. + -- If this is a warning in a spec, then we want clients + -- to see the warning, so mark the message with the + -- special sequence !! to force the warning. In the case + -- of a package spec, we do not force this if we are in + -- the private part of the spec. - if Force then - if Cont = False then - Error_Msg - ("<<~!!", Eloc, N, Is_Compile_Time_Pragma => True); - Cont := True; - else - Error_Msg - ("\<<~!!", Eloc, N, Is_Compile_Time_Pragma => True); - end if; + if Force then + Append (Msg_Ctrl, "!!"); + end if; - -- Error, rather than warning, or in a body, so we do not - -- need to force visibility for client (error will be - -- output in any case, and this is the situation in which - -- we do not want a client to get a warning, since the - -- warning is in the body or the spec private part). + -- Error, rather than warning, or in a body, so we do not + -- need to force visibility for client (error will be + -- output in any case, and this is the situation in which + -- we do not want a client to get a warning, since the + -- warning is in the body or the spec private part). - else - if Cont = False then - Error_Msg - ("<<~", Eloc, N, Is_Compile_Time_Pragma => True); - Cont := True; - else - Error_Msg - ("\<<~", Eloc, N, Is_Compile_Time_Pragma => True); - end if; - end if; + Error_Msg + (To_String (Msg_Ctrl), Eloc, N, Is_Compile_Time_Pragma => True); - exit when Ptr > Str_Len; - end loop; - end; + -- The next lines are considered continuation messages + + Cont := True; + + exit when Ptr > Str_Len; + end loop; + end Emit_Compile_Time_Message; + + -- Start of processing for Validate_Compile_Time_Warning_Or_Error + + begin + Analyze_And_Resolve (Arg1x, Standard_Boolean); + + if Compile_Time_Known_Value (Arg1x) then + if Is_True (Expr_Value (Arg1x)) then + Emit_Compile_Time_Message (Next (Arg1)); end if; -- Arg1x is not known at compile time, so possibly issue an error @@ -35101,7 +35083,17 @@ package body Sem_Prag is begin Set_Scope (T.Scope); Reset_Analyzed_Flags (T.Prag); - Validate_Compile_Time_Warning_Or_Error (T.Prag, T.Eloc); + if Nkind (T.Prag) = N_Pragma then + Validate_Compile_Time_Warning_Or_Error (T.Prag, T.Eloc); + else + pragma Assert (Nkind (Original_Node (T.Prag)) = N_Pragma); + + -- The pragma was likely removed in ignored ghost code. Check + -- the original node instead. + + Validate_Compile_Time_Warning_Or_Error + (Original_Node (T.Prag), T.Eloc); + end if; Unset_Scope (T.Scope); end; end loop; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b2b4fed..d19b3b9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1963,8 +1963,7 @@ package body Sem_Util is -- Local variables - Saved_GM : constant Ghost_Mode_Type := Ghost_Mode; - Saved_IGR : constant Node_Id := Ignored_Ghost_Region; + Saved_Ghost_Config : constant Ghost_Config_Type := Ghost_Config; -- Save the Ghost-related attributes to restore on exit -- Start of processing for Build_Elaboration_Entity @@ -2060,7 +2059,7 @@ package body Sem_Util is Set_Has_Qualified_Name (Elab_Ent); Set_Has_Fully_Qualified_Name (Elab_Ent); - Restore_Ghost_Region (Saved_GM, Saved_IGR); + Restore_Ghost_Region (Saved_Ghost_Config); end Build_Elaboration_Entity; -------------------------------- @@ -12473,6 +12472,41 @@ package body Sem_Util is end if; end Is_Extended_Access_Type; + ---------------------------------------- + -- Is_Ignored_Ghost_Entity_In_Codegen -- + ---------------------------------------- + + function Is_Ignored_Ghost_Entity_In_Codegen (N : Entity_Id) return Boolean + is + begin + return + Is_Ignored_Ghost_Entity (N) + and then not GNATprove_Mode + and then not CodePeer_Mode; + end Is_Ignored_Ghost_Entity_In_Codegen; + + ---------------------------------------- + -- Is_Ignored_Ghost_Pragma_In_Codegen -- + ---------------------------------------- + + function Is_Ignored_Ghost_Pragma_In_Codegen (N : Node_Id) return Boolean is + begin + return + Is_Ignored_Ghost_Pragma (N) + and then not GNATprove_Mode + and then not CodePeer_Mode; + end Is_Ignored_Ghost_Pragma_In_Codegen; + + --------------------------- + -- Is_Ignored_In_Codegen -- + --------------------------- + + function Is_Ignored_In_Codegen (N : Node_Id) return Boolean is + begin + return + Is_Ignored (N) and then not GNATprove_Mode and then not CodePeer_Mode; + end Is_Ignored_In_Codegen; + --------------------------------- -- Side_Effect_Free_Statements -- --------------------------------- @@ -22574,7 +22608,7 @@ package body Sem_Util is -- Mark the Ghost and SPARK mode in effect if Modes then - if Ghost_Mode = Ignore then + if Ghost_Config.Ghost_Mode = Ignore then Set_Is_Ignored_Ghost_Node (N); end if; @@ -26439,16 +26473,6 @@ package body Sem_Util is end if; end if; - -- In CodePeer mode and GNATprove mode, we need to consider all - -- assertions, unless they are disabled. Force Name_Check on - -- ignored assertions. - - if Kind in Name_Ignore | Name_Off - and then (CodePeer_Mode or GNATprove_Mode) - then - Kind := Name_Check; - end if; - return Kind; end Policy_In_Effect; @@ -26482,9 +26506,11 @@ package body Sem_Util is function Predicate_Enabled (Typ : Entity_Id) return Boolean is begin - return Present (Predicate_Function (Typ)) - and then not Predicates_Ignored (Typ) - and then not Predicate_Checks_Suppressed (Empty); + return + Present (Predicate_Function (Typ)) + and then (GNATprove_Mode + or else (not Predicates_Ignored (Typ) + and then not Predicate_Checks_Suppressed (Empty))); end Predicate_Enabled; ---------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 4554f24..47fcc7d 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2079,6 +2079,18 @@ package Sem_Util is -- . machine_emax = 2**14 -- . machine_emin = 3 - machine_emax + function Is_Ignored_Ghost_Entity_In_Codegen (N : Node_Id) return Boolean; + -- True if N Is_Ignored_Ghost_Entity and GNATProve_mode and Codepeer_Mode + -- are not active. + + function Is_Ignored_Ghost_Pragma_In_Codegen (N : Node_Id) return Boolean; + -- True if N Is_Ignored_Ghost_Pragma and GNATProve_mode and Codepeer_Mode + -- are not active. + + function Is_Ignored_In_Codegen (N : Node_Id) return Boolean; + -- True if N Is_Ignored and GNATProve_mode and Codepeer_Mode are not + -- active. + function Is_EVF_Expression (N : Node_Id) return Boolean; -- Determine whether node N denotes a reference to a formal parameter of -- a specific tagged type whose related subprogram is subject to pragma diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index 37c4949..31891de 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -40,6 +40,9 @@ package body Table is Min : constant Int := Int (Table_Low_Bound); -- Subscript of the minimum entry in the currently allocated table + Max : Int := Min + (Table_Initial * Table_Factor) - 1; + -- Subscript of the maximum entry in the currently allocated table + Length : Int := 0; -- Number of entries in currently allocated table. The value of zero -- ensures that we initially allocate the table. diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index 22e9172..623ce14 100644 --- a/gcc/ada/table.ads +++ b/gcc/ada/table.ads @@ -223,9 +223,6 @@ package Table is -- the official interfaces (since a modification to Last may require a -- reallocation of the table). - Max : Int; - -- Subscript of the maximum entry in the currently allocated table - type Saved_Table is record Last_Val : Int; Max : Int; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index 375608d..857b926 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -1600,19 +1600,17 @@ package body Treepr is -- If this is a discrete expression whose value is known, print that -- value. - if Nkind (N) in N_Subexpr + if ((Is_Entity_Name (N) -- e.g. enumeration literal + and then Present (Entity (N))) + or else Nkind (N) in N_Integer_Literal + | N_Character_Literal + | N_Unchecked_Type_Conversion) and then Compile_Time_Known_Value (N) and then Present (Etype (N)) and then Is_Discrete_Type (Etype (N)) then - if Is_Entity_Name (N) -- e.g. enumeration literal - or else Nkind (N) in N_Integer_Literal - | N_Character_Literal - | N_Unchecked_Type_Conversion - then - Print_Str (" val = "); - UI_Write (Expr_Value (N)); - end if; + Print_Str (" val = "); + UI_Write (Expr_Value (N)); end if; if Nkind (N) in N_Entity then |