diff options
Diffstat (limited to 'gcc/ada/exp_ch7.adb')
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 87 |
1 files changed, 56 insertions, 31 deletions
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 62e9d2c..600d333 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4758,18 +4758,18 @@ package body Exp_Ch7 is -- We mark the secondary stack if it is used in this construct, and -- we're not returning a function result on the secondary stack, except - -- that a build-in-place function that might or might not return on the - -- secondary stack always needs a mark. A run-time test is required in - -- the case where the build-in-place function has a BIP_Alloc extra - -- parameter (see Create_Finalizer). + -- that a build-in-place function that only conditionally returns on + -- the secondary stack will also need a mark. A run-time test for doing + -- the release call is needed in the case where the build-in-place + -- function has a BIP_Alloc_Form parameter (see Create_Finalizer). Needs_Sec_Stack_Mark : constant Boolean := - (Uses_Sec_Stack (Scop) - and then - not Sec_Stack_Needed_For_Return (Scop)) - or else - (Is_Build_In_Place_Function (Scop) - and then Needs_BIP_Alloc_Form (Scop)); + Uses_Sec_Stack (Scop) + and then + (not Sec_Stack_Needed_For_Return (Scop) + or else + (Is_Build_In_Place_Function (Scop) + and then Needs_BIP_Alloc_Form (Scop))); Needs_Custom_Cleanup : constant Boolean := Nkind (N) = N_Block_Statement @@ -9244,7 +9244,7 @@ package body Exp_Ch7 is procedure Unnest_Loop (Loop_Stmt : Node_Id) is - procedure Fixup_Inner_Scopes (Loop_Or_Block : Node_Id); + procedure Fixup_Inner_Scopes (N : Node_Id); -- This procedure fixes the scope for 2 identified cases of incorrect -- scope information. -- @@ -9271,6 +9271,9 @@ package body Exp_Ch7 is -- leaves the Tree in an incoherent state (i.e. the inner procedure must -- have its enclosing procedure in its scope ancestries). + -- The same issue exists for freeze nodes with associated TSS: the node + -- is moved but the TSS procedures are not correctly nested. + -- 2) The second case happens when an object declaration is created -- within a loop used to initialize the 'others' components of an -- aggregate that is nested within a transient scope. When the transient @@ -9298,40 +9301,62 @@ package body Exp_Ch7 is -- an actual entity set). But unfortunately this proved harder to -- implement ??? - procedure Fixup_Inner_Scopes (Loop_Or_Block : Node_Id) is - Stmt : Node_Id; - Loop_Or_Block_Ent : Entity_Id; - Ent_To_Fix : Entity_Id; - Decl : Node_Id := Empty; + procedure Fixup_Inner_Scopes (N : Node_Id) is + Stmt : Node_Id := Empty; + Ent : Entity_Id; + Ent_To_Fix : Entity_Id; + Decl : Node_Id := Empty; + Elmt : Elmt_Id := No_Elmt; begin - pragma Assert (Nkind (Loop_Or_Block) in - N_Loop_Statement | N_Block_Statement); - - Loop_Or_Block_Ent := Entity (Identifier (Loop_Or_Block)); - if Nkind (Loop_Or_Block) = N_Loop_Statement then - Stmt := First (Statements (Loop_Or_Block)); - else -- N_Block_Statement - Stmt := First - (Statements (Handled_Statement_Sequence (Loop_Or_Block))); - Decl := First (Declarations (Loop_Or_Block)); + pragma + Assert + (Nkind (N) + in N_Loop_Statement | N_Block_Statement | N_Freeze_Entity); + + if Nkind (N) = N_Freeze_Entity then + Ent := Scope (Entity (N)); + else + Ent := Entity (Identifier (N)); end if; + case Nkind (N) is + when N_Loop_Statement => + Stmt := First (Statements (N)); + + when N_Block_Statement => + Stmt := First (Statements (Handled_Statement_Sequence (N))); + Decl := First (Declarations (N)); + + when N_Freeze_Entity => + if Present (TSS_Elist (N)) then + Elmt := First_Elmt (TSS_Elist (N)); + while Present (Elmt) loop + Ent_To_Fix := Node (Elmt); + Set_Scope (Ent_To_Fix, Ent); + Next_Elmt (Elmt); + end loop; + end if; + + when others => + pragma Assert (False); + end case; + -- Fix scopes for any object declaration found in the block while Present (Decl) loop if Nkind (Decl) = N_Object_Declaration then Ent_To_Fix := Defining_Identifier (Decl); - Set_Scope (Ent_To_Fix, Loop_Or_Block_Ent); + Set_Scope (Ent_To_Fix, Ent); end if; Next (Decl); end loop; while Present (Stmt) loop - if Nkind (Stmt) = N_Block_Statement - and then Is_Abort_Block (Stmt) + if Nkind (Stmt) = N_Block_Statement and then Is_Abort_Block (Stmt) then Ent_To_Fix := Entity (Identifier (Stmt)); - Set_Scope (Ent_To_Fix, Loop_Or_Block_Ent); - elsif Nkind (Stmt) in N_Block_Statement | N_Loop_Statement + Set_Scope (Ent_To_Fix, Ent); + elsif Nkind (Stmt) + in N_Block_Statement | N_Loop_Statement | N_Freeze_Entity then Fixup_Inner_Scopes (Stmt); end if; |