From f037632e655c8348b06ffa797c9b1041a5a823ec Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 7 May 2021 10:41:03 -0400 Subject: [PATCH] [Ada] Transient scope cleanup gcc/ada/ * sem.ads (Node_To_Be_Wrapped): Minor comment fix. * exp_ch7.adb (Establish_Transient_Scope): Misc cleanups and comment improvements. (Set_Node_To_Be_Wrapped): Remove -- not worth putting this code in a separate procedure, called only once. * sem_util.adb (Requires_Transient_Scope): Assert that our parameter has the right Kind. It probably shouldn't be E_Void, but that is passed in in some cases. (Ensure_Minimum_Decoration): Move the call later, so we know Typ is Present, and remove "if Present (Typ)" from this procedure. * exp_aggr.adb (Convert_To_Assignments): Use membership test, and avoid the "if False" idiom. (Expand_Array_Aggregate): Remove a ??? comment. * sem_ch8.adb (Push_Scope): Take advantage of the full coverage rules for aggregates. * sem_res.adb (Resolve_Declare_Expression): Remove test for Is_Type -- that's all it can be. Use named notation in call to Establish_Transient_Scope. * libgnat/a-cdlili.adb (Adjust): Remove redundant code. (Clear): Remove "pragma Warnings (Off);", which wasn't actually suppressing any warnings. --- gcc/ada/exp_aggr.adb | 12 +- gcc/ada/exp_ch7.adb | 474 +++++++++++++++++++++---------------------- gcc/ada/libgnat/a-cdlili.adb | 7 - gcc/ada/sem.ads | 2 +- gcc/ada/sem_ch8.adb | 86 ++++---- gcc/ada/sem_res.adb | 3 +- gcc/ada/sem_util.adb | 12 +- 7 files changed, 287 insertions(+), 309 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 7978b1caf7c..1b084366605 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4919,13 +4919,11 @@ package body Exp_Aggr is -- Just set the Delay flag in the cases where the transformation will be -- done top down from above. - if False - + if -- Internal aggregate (transformed when expanding the parent) - or else Parent_Kind = N_Aggregate - or else Parent_Kind = N_Extension_Aggregate - or else Parent_Kind = N_Component_Association + Parent_Kind in + N_Aggregate | N_Extension_Aggregate | N_Component_Association -- Allocator (see Convert_Aggr_In_Allocator) @@ -6601,8 +6599,8 @@ package body Exp_Aggr is -- For assignments we do the assignment in place if all the component -- associations have compile-time known values, or are default- -- initialized limited components, e.g. tasks. For other cases we - -- create a temporary. The analysis for safety of on-line assignment - -- is delicate, i.e. we don't know how to do it fully yet ??? + -- create a temporary. A full analysis for safety of in-place assignment + -- is delicate. -- For allocators we assign to the designated object in place if the -- aggregate meets the same conditions as other in-place assignments. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 469c9fbfb88..4c1e16d9e32 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -131,11 +131,6 @@ package body Exp_Ch7 is -- Transient Blocks and Finalization Management -- -------------------------------------------------- - function Find_Transient_Context (N : Node_Id) return Node_Id; - -- Locate a suitable context for arbitrary node N which may need to be - -- serviced by a transient scope. Return Empty if no suitable context is - -- available. - procedure Insert_Actions_In_Scope_Around (N : Node_Id; Clean : Boolean; @@ -155,9 +150,6 @@ package body Exp_Ch7 is -- involves controlled objects or secondary stack usage, the corresponding -- cleanup actions are performed at the end of the block. - procedure Set_Node_To_Be_Wrapped (N : Node_Id); - -- Set the field Node_To_Be_Wrapped of the current scope - procedure Store_Actions_In_Scope (AK : Scope_Action_Kind; L : List_Id); -- Shared processing for Store_xxx_Actions_In_Scope @@ -5151,37 +5143,47 @@ package body Exp_Ch7 is (N : Node_Id; Manage_Sec_Stack : Boolean) is - procedure Create_Transient_Scope (Constr : Node_Id); - -- Place a new scope on the scope stack in order to service construct - -- Constr. The new scope may also manage the secondary stack. + function Is_Package_Or_Subprogram (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary Id denotes a package or subprogram [body] + + function Find_Enclosing_Transient_Scope return Entity_Id; + -- Examine the scope stack looking for the nearest enclosing transient + -- scope within the innermost enclosing package or subprogram. Return + -- Empty if no such scope exists. + + function Find_Transient_Context (N : Node_Id) return Node_Id; + -- Locate a suitable context for arbitrary node N which may need to be + -- serviced by a transient scope. Return Empty if no suitable context + -- is available. procedure Delegate_Sec_Stack_Management; -- Move the management of the secondary stack to the nearest enclosing -- suitable scope. - function Find_Enclosing_Transient_Scope return Entity_Id; - -- Examine the scope stack looking for the nearest enclosing transient - -- scope. Return Empty if no such scope exists. - - function Is_Package_Or_Subprogram (Id : Entity_Id) return Boolean; - -- Determine whether arbitrary Id denotes a package or subprogram [body] + procedure Create_Transient_Scope (Context : Node_Id); + -- Place a new scope on the scope stack in order to service construct + -- Context. Context is the node found by Find_Transient_Context. The + -- new scope may also manage the secondary stack. ---------------------------- -- Create_Transient_Scope -- ---------------------------- - procedure Create_Transient_Scope (Constr : Node_Id) is + procedure Create_Transient_Scope (Context : Node_Id) is Loc : constant Source_Ptr := Sloc (N); Iter_Loop : Entity_Id; - Trans_Scop : Entity_Id; + Trans_Scop : constant Entity_Id := + New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); begin - Trans_Scop := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); Set_Etype (Trans_Scop, Standard_Void_Type); + -- Push a new scope, and set its Node_To_Be_Wrapped and Is_Transient + -- fields. + Push_Scope (Trans_Scop); - Set_Node_To_Be_Wrapped (Constr); + Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped := Context; Set_Scope_Is_Transient; -- The transient scope must also manage the secondary stack @@ -5232,37 +5234,34 @@ package body Exp_Ch7 is ----------------------------------- procedure Delegate_Sec_Stack_Management is - Scop_Id : Entity_Id; - Scop_Rec : Scope_Stack_Entry; - begin for Index in reverse Scope_Stack.First .. Scope_Stack.Last loop - Scop_Rec := Scope_Stack.Table (Index); - Scop_Id := Scop_Rec.Entity; - - -- Prevent the search from going too far or within the scope space - -- of another unit. + declare + Scope : Scope_Stack_Entry renames Scope_Stack.Table (Index); + begin + -- Prevent the search from going too far or within the scope + -- space of another unit. - if Scop_Id = Standard_Standard then - return; + if Scope.Entity = Standard_Standard then + return; - -- No transient scope should be encountered during the traversal - -- because Establish_Transient_Scope should have already handled - -- this case. + -- No transient scope should be encountered during the + -- traversal because Establish_Transient_Scope should have + -- already handled this case. - elsif Scop_Rec.Is_Transient then - pragma Assert (False); - return; + elsif Scope.Is_Transient then + raise Program_Error; - -- The construct which requires secondary stack management is - -- always enclosed by a package or subprogram scope. + -- The construct that requires secondary stack management is + -- always enclosed by a package or subprogram scope. - elsif Is_Package_Or_Subprogram (Scop_Id) then - Set_Uses_Sec_Stack (Scop_Id); - Check_Restriction (No_Secondary_Stack, N); + elsif Is_Package_Or_Subprogram (Scope.Entity) then + Set_Uses_Sec_Stack (Scope.Entity); + Check_Restriction (No_Secondary_Stack, N); - return; - end if; + return; + end if; + end; end loop; -- At this point no suitable scope was found. This should never occur @@ -5277,30 +5276,198 @@ package body Exp_Ch7 is ------------------------------------ function Find_Enclosing_Transient_Scope return Entity_Id is - Scop_Id : Entity_Id; - Scop_Rec : Scope_Stack_Entry; - begin for Index in reverse Scope_Stack.First .. Scope_Stack.Last loop - Scop_Rec := Scope_Stack.Table (Index); - Scop_Id := Scop_Rec.Entity; - - -- Prevent the search from going too far or within the scope space - -- of another unit. + declare + Scope : Scope_Stack_Entry renames Scope_Stack.Table (Index); + begin + -- Prevent the search from going too far or within the scope + -- space of another unit. - if Scop_Id = Standard_Standard - or else Is_Package_Or_Subprogram (Scop_Id) - then - exit; + if Scope.Entity = Standard_Standard + or else Is_Package_Or_Subprogram (Scope.Entity) + then + exit; - elsif Scop_Rec.Is_Transient then - return Scop_Id; - end if; + elsif Scope.Is_Transient then + return Scope.Entity; + end if; + end; end loop; return Empty; end Find_Enclosing_Transient_Scope; + ---------------------------- + -- Find_Transient_Context -- + ---------------------------- + + function Find_Transient_Context (N : Node_Id) return Node_Id is + Curr : Node_Id := N; + Prev : Node_Id := Empty; + + begin + while Present (Curr) loop + case Nkind (Curr) is + + -- Declarations + + -- Declarations act as a boundary for a transient scope even if + -- they are not wrapped, see Wrap_Transient_Declaration. + + when N_Object_Declaration + | N_Object_Renaming_Declaration + | N_Subtype_Declaration + => + return Curr; + + -- Statements + + -- Statements and statement-like constructs act as a boundary + -- for a transient scope. + + when N_Accept_Alternative + | N_Attribute_Definition_Clause + | N_Case_Statement + | N_Case_Statement_Alternative + | N_Code_Statement + | N_Delay_Alternative + | N_Delay_Until_Statement + | N_Delay_Relative_Statement + | N_Discriminant_Association + | N_Elsif_Part + | N_Entry_Body_Formal_Part + | N_Exit_Statement + | N_If_Statement + | N_Iteration_Scheme + | N_Terminate_Alternative + => + pragma Assert (Present (Prev)); + return Prev; + + when N_Assignment_Statement => + return Curr; + + when N_Entry_Call_Statement + | N_Procedure_Call_Statement + => + -- When an entry or procedure call acts as the alternative + -- of a conditional or timed entry call, the proper context + -- is that of the alternative. + + if Nkind (Parent (Curr)) = N_Entry_Call_Alternative + and then Nkind (Parent (Parent (Curr))) in + N_Conditional_Entry_Call | N_Timed_Entry_Call + then + return Parent (Parent (Curr)); + + -- General case for entry or procedure calls + + else + return Curr; + end if; + + when N_Pragma => + + -- Pragma Check is not a valid transient context in + -- GNATprove mode because the pragma must remain unchanged. + + if GNATprove_Mode + and then Get_Pragma_Id (Curr) = Pragma_Check + then + return Empty; + + -- General case for pragmas + + else + return Curr; + end if; + + when N_Raise_Statement => + return Curr; + + when N_Simple_Return_Statement => + + -- A return statement is not a valid transient context when + -- the function itself requires transient scope management + -- because the result will be reclaimed too early. + + if Requires_Transient_Scope (Etype + (Return_Applies_To (Return_Statement_Entity (Curr)))) + then + return Empty; + + -- General case for return statements + + else + return Curr; + end if; + + -- Special + + when N_Attribute_Reference => + if Is_Procedure_Attribute_Name (Attribute_Name (Curr)) then + return Curr; + end if; + + -- An Ada 2012 iterator specification is not a valid context + -- because Analyze_Iterator_Specification already employs + -- special processing for it. + + when N_Iterator_Specification => + return Empty; + + when N_Loop_Parameter_Specification => + + -- An iteration scheme is not a valid context because + -- routine Analyze_Iteration_Scheme already employs + -- special processing. + + if Nkind (Parent (Curr)) = N_Iteration_Scheme then + return Empty; + else + return Parent (Curr); + end if; + + -- Termination + + -- The following nodes represent "dummy contexts" which do not + -- need to be wrapped. + + when N_Component_Declaration + | N_Discriminant_Specification + | N_Parameter_Specification + => + return Empty; + + -- If the traversal leaves a scope without having been able to + -- find a construct to wrap, something is going wrong, but this + -- can happen in error situations that are not detected yet + -- (such as a dynamic string in a pragma Export). + + when N_Block_Statement + | N_Entry_Body + | N_Package_Body + | N_Package_Declaration + | N_Protected_Body + | N_Subprogram_Body + | N_Task_Body + => + return Empty; + + -- Default + + when others => + null; + end case; + + Prev := Curr; + Curr := Parent (Curr); + end loop; + + return Empty; + end Find_Transient_Context; + ------------------------------ -- Is_Package_Or_Subprogram -- ------------------------------ @@ -5323,8 +5490,8 @@ package body Exp_Ch7 is -- Start of processing for Establish_Transient_Scope begin - -- Do not create a new transient scope if there is an existing transient - -- scope on the stack. + -- Do not create a new transient scope if there is already an enclosing + -- transient scope within the innermost enclosing package or subprogram. if Present (Trans_Id) then @@ -5338,9 +5505,8 @@ package body Exp_Ch7 is return; end if; - -- At this point it is known that the scope stack is free of transient - -- scopes. Locate the proper construct which must be serviced by a new - -- transient scope. + -- Find the construct that must be serviced by a new transient scope, if + -- it exists. Context := Find_Transient_Context (N); @@ -5950,177 +6116,6 @@ package body Exp_Ch7 is end if; end Expand_N_Package_Declaration; - ---------------------------- - -- Find_Transient_Context -- - ---------------------------- - - function Find_Transient_Context (N : Node_Id) return Node_Id is - Curr : Node_Id; - Prev : Node_Id; - - begin - Curr := N; - Prev := Empty; - while Present (Curr) loop - case Nkind (Curr) is - - -- Declarations - - -- Declarations act as a boundary for a transient scope even if - -- they are not wrapped, see Wrap_Transient_Declaration. - - when N_Object_Declaration - | N_Object_Renaming_Declaration - | N_Subtype_Declaration - => - return Curr; - - -- Statements - - -- Statements and statement-like constructs act as a boundary for - -- a transient scope. - - when N_Accept_Alternative - | N_Attribute_Definition_Clause - | N_Case_Statement - | N_Case_Statement_Alternative - | N_Code_Statement - | N_Delay_Alternative - | N_Delay_Until_Statement - | N_Delay_Relative_Statement - | N_Discriminant_Association - | N_Elsif_Part - | N_Entry_Body_Formal_Part - | N_Exit_Statement - | N_If_Statement - | N_Iteration_Scheme - | N_Terminate_Alternative - => - pragma Assert (Present (Prev)); - return Prev; - - when N_Assignment_Statement => - return Curr; - - when N_Entry_Call_Statement - | N_Procedure_Call_Statement - => - -- When an entry or procedure call acts as the alternative of a - -- conditional or timed entry call, the proper context is that - -- of the alternative. - - if Nkind (Parent (Curr)) = N_Entry_Call_Alternative - and then Nkind (Parent (Parent (Curr))) in - N_Conditional_Entry_Call | N_Timed_Entry_Call - then - return Parent (Parent (Curr)); - - -- General case for entry or procedure calls - - else - return Curr; - end if; - - when N_Pragma => - - -- Pragma Check is not a valid transient context in GNATprove - -- mode because the pragma must remain unchanged. - - if GNATprove_Mode - and then Get_Pragma_Id (Curr) = Pragma_Check - then - return Empty; - - -- General case for pragmas - - else - return Curr; - end if; - - when N_Raise_Statement => - return Curr; - - when N_Simple_Return_Statement => - - -- A return statement is not a valid transient context when the - -- function itself requires transient scope management because - -- the result will be reclaimed too early. - - if Requires_Transient_Scope (Etype - (Return_Applies_To (Return_Statement_Entity (Curr)))) - then - return Empty; - - -- General case for return statements - - else - return Curr; - end if; - - -- Special - - when N_Attribute_Reference => - if Is_Procedure_Attribute_Name (Attribute_Name (Curr)) then - return Curr; - end if; - - -- An Ada 2012 iterator specification is not a valid context - -- because Analyze_Iterator_Specification already employs special - -- processing for it. - - when N_Iterator_Specification => - return Empty; - - when N_Loop_Parameter_Specification => - - -- An iteration scheme is not a valid context because routine - -- Analyze_Iteration_Scheme already employs special processing. - - if Nkind (Parent (Curr)) = N_Iteration_Scheme then - return Empty; - else - return Parent (Curr); - end if; - - -- Termination - - -- The following nodes represent "dummy contexts" which do not - -- need to be wrapped. - - when N_Component_Declaration - | N_Discriminant_Specification - | N_Parameter_Specification - => - return Empty; - - -- If the traversal leaves a scope without having been able to - -- find a construct to wrap, something is going wrong, but this - -- can happen in error situations that are not detected yet (such - -- as a dynamic string in a pragma Export). - - when N_Block_Statement - | N_Entry_Body - | N_Package_Body - | N_Package_Declaration - | N_Protected_Body - | N_Subprogram_Body - | N_Task_Body - => - return Empty; - - -- Default - - when others => - null; - end case; - - Prev := Curr; - Curr := Parent (Curr); - end loop; - - return Empty; - end Find_Transient_Context; - --------------------------------- -- Has_Simple_Protected_Object -- --------------------------------- @@ -9891,15 +9886,6 @@ package body Exp_Ch7 is end Node_To_Be_Wrapped; ---------------------------- - -- Set_Node_To_Be_Wrapped -- - ---------------------------- - - procedure Set_Node_To_Be_Wrapped (N : Node_Id) is - begin - Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped := N; - end Set_Node_To_Be_Wrapped; - - ---------------------------- -- Store_Actions_In_Scope -- ---------------------------- diff --git a/gcc/ada/libgnat/a-cdlili.adb b/gcc/ada/libgnat/a-cdlili.adb index 73c1e6d7827..75961a29ddb 100644 --- a/gcc/ada/libgnat/a-cdlili.adb +++ b/gcc/ada/libgnat/a-cdlili.adb @@ -130,11 +130,6 @@ is pragma Assert (Container.Last.Next = null); pragma Assert (Container.Length > 0); - Container.First := null; - Container.Last := null; - Container.Length := 0; - Zero_Counts (Container.TC); - Container.First := new Node_Type'(Src.Element, null, null); Container.Last := Container.First; Container.Length := 1; @@ -232,9 +227,7 @@ is Container.Last := null; Container.Length := 0; - pragma Warnings (Off); Free (X); - pragma Warnings (On); end Clear; ------------------------ diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index a56ce937b91..2fdccf756a6 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -533,7 +533,7 @@ package Sem is -- See Sem_Ch10 (Install_Parents, Remove_Parents). Node_To_Be_Wrapped : Node_Id; - -- Only used in transient scopes. Records the node which will be wrapped + -- Only used in transient scopes. Records the node that will be wrapped -- by the transient block. Actions_To_Be_Wrapped : Scope_Actions; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index d3bbfebd0e7..f056a189b2d 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -8995,6 +8995,28 @@ package body Sem_Ch8 is procedure Push_Scope (S : Entity_Id) is E : constant Entity_Id := Scope (S); + function Component_Alignment_Default return Component_Alignment_Kind; + -- Return Component_Alignment_Kind for the newly-pushed scope. + + function Component_Alignment_Default return Component_Alignment_Kind is + begin + -- Each new scope pushed onto the scope stack inherits the component + -- alignment of the previous scope. This emulates the "visibility" + -- semantics of pragma Component_Alignment. + + if Scope_Stack.Last > Scope_Stack.First then + return Scope_Stack.Table + (Scope_Stack.Last - 1).Component_Alignment_Default; + + -- Otherwise, this is the first scope being pushed on the scope + -- stack. Inherit the component alignment from the configuration + -- form of pragma Component_Alignment (if any). + + else + return Configuration_Component_Alignment; + end if; + end Component_Alignment_Default; + begin if Ekind (S) = E_Void then null; @@ -9023,49 +9045,27 @@ package body Sem_Ch8 is Scope_Stack.Increment_Last; - declare - SST : Scope_Stack_Entry renames Scope_Stack.Table (Scope_Stack.Last); - - begin - SST.Entity := S; - SST.Save_Scope_Suppress := Scope_Suppress; - SST.Save_Local_Suppress_Stack_Top := Local_Suppress_Stack_Top; - SST.Save_Check_Policy_List := Check_Policy_List; - SST.Save_Default_Storage_Pool := Default_Pool; - SST.Save_No_Tagged_Streams := No_Tagged_Streams; - SST.Save_SPARK_Mode := SPARK_Mode; - SST.Save_SPARK_Mode_Pragma := SPARK_Mode_Pragma; - SST.Save_Default_SSO := Default_SSO; - SST.Save_Uneval_Old := Uneval_Old; - - -- Each new scope pushed onto the scope stack inherits the component - -- alignment of the previous scope. This emulates the "visibility" - -- semantics of pragma Component_Alignment. - - if Scope_Stack.Last > Scope_Stack.First then - SST.Component_Alignment_Default := - Scope_Stack.Table - (Scope_Stack.Last - 1).Component_Alignment_Default; - - -- Otherwise, this is the first scope being pushed on the scope - -- stack. Inherit the component alignment from the configuration - -- form of pragma Component_Alignment (if any). - - else - SST.Component_Alignment_Default := - Configuration_Component_Alignment; - end if; - - SST.Last_Subprogram_Name := null; - SST.Is_Transient := False; - SST.Node_To_Be_Wrapped := Empty; - SST.Pending_Freeze_Actions := No_List; - SST.Actions_To_Be_Wrapped := (others => No_List); - SST.First_Use_Clause := Empty; - SST.Is_Active_Stack_Base := False; - SST.Previous_Visibility := False; - SST.Locked_Shared_Objects := No_Elist; - end; + Scope_Stack.Table (Scope_Stack.Last) := + (Entity => S, + Save_Scope_Suppress => Scope_Suppress, + Save_Local_Suppress_Stack_Top => Local_Suppress_Stack_Top, + Save_Check_Policy_List => Check_Policy_List, + Save_Default_Storage_Pool => Default_Pool, + Save_No_Tagged_Streams => No_Tagged_Streams, + Save_SPARK_Mode => SPARK_Mode, + Save_SPARK_Mode_Pragma => SPARK_Mode_Pragma, + Save_Default_SSO => Default_SSO, + Save_Uneval_Old => Uneval_Old, + Component_Alignment_Default => Component_Alignment_Default, + Last_Subprogram_Name => null, + Is_Transient => False, + Node_To_Be_Wrapped => Empty, + Pending_Freeze_Actions => No_List, + Actions_To_Be_Wrapped => (others => No_List), + First_Use_Clause => Empty, + Is_Active_Stack_Base => False, + Previous_Visibility => False, + Locked_Shared_Objects => No_Elist); if Debug_Flag_W then Write_Str ("--> new scope: "); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 494904faa55..3ebf93ae080 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7521,7 +7521,6 @@ package body Sem_Res is Node := First (Actions (N)); while Present (Node) loop if Nkind (Node) = N_Object_Declaration - and then Is_Type (Etype (Defining_Identifier (Node))) and then Requires_Transient_Scope (Etype (Defining_Identifier (Node))) then @@ -7534,7 +7533,7 @@ package body Sem_Res is end; if Need_Transient_Scope then - Establish_Transient_Scope (Decl, True); + Establish_Transient_Scope (Decl, Manage_Sec_Stack => True); else Push_Scope (Scope (Defining_Identifier (Decl))); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 038c1ee686b..5c6a70134af 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -26956,6 +26956,8 @@ package body Sem_Util is -- generated before the next instruction. function Requires_Transient_Scope (Id : Entity_Id) return Boolean is + pragma Assert (if Present (Id) then Ekind (Id) in E_Void | Type_Kind); + function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean; -- This is called for untagged records and protected types, with -- nondefaulted discriminants. Returns True if the size of function @@ -27036,8 +27038,7 @@ package body Sem_Util is -- Do not set Has_Controlled_Component on a class-wide equivalent -- type. See Make_CW_Equivalent_Type. - if Present (Typ) - and then not Is_Frozen (Typ) + if not Is_Frozen (Typ) and then Is_Base_Type (Typ) and then (Is_Record_Type (Typ) or else Is_Concurrent_Type (Typ) @@ -27154,19 +27155,20 @@ package body Sem_Util is -- Start of processing for Requires_Transient_Scope begin - Ensure_Minimum_Decoration (Id); - -- This is a private type which is not completed yet. This can only -- happen in a default expression (of a formal parameter or of a -- record component). Do not expand transient scope in this case. if No (Typ) then return False; + end if; + + Ensure_Minimum_Decoration (Id); -- Do not expand transient scope for non-existent procedure return or -- string literal types. - elsif Typ = Standard_Void_Type + if Typ = Standard_Void_Type or else Ekind (Typ) = E_String_Literal_Subtype then return False; -- 2.11.4.GIT