diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -613,14 +613,14 @@ package body Sem_Ch12 is -- packages, and the prefix of the formal type may be needed to resolve -- the ambiguity in the instance ??? - procedure Freeze_Subprogram_Body - (Inst_Node : Node_Id; + procedure Freeze_Subprogram_Instance + (N : Node_Id; Gen_Body : Node_Id; Pack_Id : Entity_Id); -- The generic body may appear textually after the instance, including -- in the proper body of a stub, or within a different package instance. -- Given that the instance can only be elaborated after the generic, we - -- place freeze_nodes for the instance and/or for packages that may enclose + -- place freeze nodes for the instance and/or for packages that may enclose -- the instance and the generic, so that the back-end can establish the -- proper order of elaboration. @@ -714,13 +714,15 @@ package body Sem_Ch12 is -- associated freeze node. Insert the freeze node before the first source -- body which follows immediately after N. If no such body is found, the -- freeze node is inserted at the end of the declarative region which - -- contains N. + -- contains N. This can also be invoked to insert the freeze node of a + -- package that encloses an instantiation, in which case N may denote an + -- arbitrary node. - procedure Install_Body - (Act_Body : Node_Id; - N : Node_Id; + procedure Freeze_Package_Instance + (N : Node_Id; Gen_Body : Node_Id; - Gen_Decl : Node_Id); + Gen_Decl : Node_Id; + Act_Id : Entity_Id); -- If the instantiation happens textually before the body of the generic, -- the instantiation of the body must be analyzed after the generic body, -- and not at the point of instantiation. Such early instantiations can @@ -9015,22 +9017,15 @@ package body Sem_Ch12 is end if; end Find_Actual_Type; - ---------------------------- - -- Freeze_Subprogram_Body -- - ---------------------------- + -------------------------------- + -- Freeze_Subprogram_Instance -- + -------------------------------- - procedure Freeze_Subprogram_Body - (Inst_Node : Node_Id; + procedure Freeze_Subprogram_Instance + (N : Node_Id; Gen_Body : Node_Id; Pack_Id : Entity_Id) is - Gen_Unit : constant Entity_Id := Get_Generic_Entity (Inst_Node); - Par : constant Entity_Id := Scope (Gen_Unit); - Enc_G : Entity_Id; - Enc_G_F : Node_Id; - Enc_I : Node_Id; - F_Node : Node_Id; - function Enclosing_Package_Body (N : Node_Id) return Node_Id; -- Find innermost package body that encloses the given node, and which -- is not a compilation unit. Freeze nodes for the instance, or for its @@ -9086,7 +9081,16 @@ package body Sem_Ch12 is return Freeze_Node (Id); end Package_Freeze_Node; - -- Start of processing for Freeze_Subprogram_Body + -- Local variables + + Enc_G : constant Node_Id := Enclosing_Package_Body (Gen_Body); + Enc_N : constant Node_Id := Enclosing_Package_Body (N); + Par_Id : constant Entity_Id := Scope (Get_Generic_Entity (N)); + + Enc_G_F : Node_Id; + F_Node : Node_Id; + + -- Start of processing for Freeze_Subprogram_Instance begin -- If the instance and the generic body appear within the same unit, and @@ -9097,21 +9101,18 @@ package body Sem_Ch12 is -- packages. Otherwise, the freeze node is placed at the end of the -- current declarative part. - Enc_G := Enclosing_Package_Body (Gen_Body); - Enc_I := Enclosing_Package_Body (Inst_Node); Ensure_Freeze_Node (Pack_Id); F_Node := Freeze_Node (Pack_Id); - if Is_Generic_Instance (Par) - and then Present (Freeze_Node (Par)) - and then In_Same_Declarative_Part - (Parent (Freeze_Node (Par)), Inst_Node) + if Is_Generic_Instance (Par_Id) + and then Present (Freeze_Node (Par_Id)) + and then In_Same_Declarative_Part (Parent (Freeze_Node (Par_Id)), N) then -- The parent was a premature instantiation. Insert freeze node at -- the end the current declarative part. - if Is_Known_Guaranteed_ABE (Get_Unit_Instantiation_Node (Par)) then - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + if Is_Known_Guaranteed_ABE (Get_Unit_Instantiation_Node (Par_Id)) then + Insert_Freeze_Node_For_Instance (N, F_Node); -- Handle the following case: -- @@ -9131,13 +9132,13 @@ package body Sem_Ch12 is -- after that of Parent_Inst. This relation is established by -- comparing the Slocs of Parent_Inst freeze node and Inst. - elsif In_Same_List (Get_Unit_Instantiation_Node (Par), Inst_Node) - and then Sloc (Freeze_Node (Par)) <= Sloc (Inst_Node) + elsif In_Same_List (Get_Unit_Instantiation_Node (Par_Id), N) + and then Sloc (Freeze_Node (Par_Id)) <= Sloc (N) then - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); else - Insert_After (Freeze_Node (Par), F_Node); + Insert_After (Freeze_Node (Par_Id), F_Node); end if; -- The body enclosing the instance should be frozen after the body that @@ -9147,26 +9148,27 @@ package body Sem_Ch12 is -- already, freeze the instance at the end of the current declarative -- part. - elsif Is_Generic_Instance (Par) - and then Present (Freeze_Node (Par)) - and then Present (Enc_I) + elsif Is_Generic_Instance (Par_Id) + and then Present (Freeze_Node (Par_Id)) + and then Present (Enc_N) then - if In_Same_Declarative_Part (Parent (Freeze_Node (Par)), Enc_I) then + if In_Same_Declarative_Part (Parent (Freeze_Node (Par_Id)), Enc_N) + then -- The enclosing package may contain several instances. Rather -- than computing the earliest point at which to insert its freeze -- node, we place it at the end of the declarative part of the -- parent of the generic. Insert_Freeze_Node_For_Instance - (Freeze_Node (Par), Package_Freeze_Node (Enc_I)); + (Freeze_Node (Par_Id), Package_Freeze_Node (Enc_N)); end if; - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); elsif Present (Enc_G) - and then Present (Enc_I) - and then Enc_G /= Enc_I - and then Earlier (Inst_Node, Gen_Body) + and then Present (Enc_N) + and then Enc_G /= Enc_N + and then Earlier (N, Gen_Body) then -- Freeze package that encloses instance, and place node after the -- package that encloses generic. If enclosing package is already @@ -9181,15 +9183,15 @@ package body Sem_Ch12 is Enclosing_Body : Node_Id; begin - if Nkind (Enc_I) = N_Package_Body_Stub then - Enclosing_Body := Proper_Body (Unit (Library_Unit (Enc_I))); + if Nkind (Enc_N) = N_Package_Body_Stub then + Enclosing_Body := Proper_Body (Unit (Library_Unit (Enc_N))); else - Enclosing_Body := Enc_I; + Enclosing_Body := Enc_N; end if; if Parent (List_Containing (Enc_G)) /= Enclosing_Body then Insert_Freeze_Node_For_Instance - (Enc_G, Package_Freeze_Node (Enc_I)); + (Enc_G, Package_Freeze_Node (Enc_N)); end if; end; @@ -9201,15 +9203,15 @@ package body Sem_Ch12 is Insert_After (Enc_G, Enc_G_F); end if; - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); else -- If none of the above, insert freeze node at the end of the current -- declarative part. - Insert_Freeze_Node_For_Instance (Inst_Node, F_Node); + Insert_Freeze_Node_For_Instance (N, F_Node); end if; - end Freeze_Subprogram_Body; + end Freeze_Subprogram_Instance; ---------------- -- Get_Gen_Id -- @@ -9571,10 +9573,11 @@ package body Sem_Ch12 is (N : Node_Id; F_Node : Node_Id) is - Decl : Node_Id; - Decls : List_Id; - Inst : Entity_Id; - Par_N : Node_Id; + Decl : Node_Id; + Decls : List_Id; + Inst : Entity_Id; + Par_Inst : Node_Id; + Par_N : Node_Id; function Enclosing_Body (N : Node_Id) return Node_Id; -- Find enclosing package or subprogram body, if any. Freeze node may @@ -9640,8 +9643,8 @@ package body Sem_Ch12 is if not Is_List_Member (F_Node) then Decl := N; Decls := List_Containing (N); - Inst := Entity (F_Node); Par_N := Parent (Decls); + Inst := Entity (F_Node); -- When processing a subprogram instantiation, utilize the actual -- subprogram instantiation rather than its package wrapper as it @@ -9651,18 +9654,18 @@ package body Sem_Ch12 is Inst := Related_Instance (Inst); end if; + Par_Inst := Parent (Inst); + -- If this is a package instance, check whether the generic is -- declared in a previous instance and the current instance is -- not within the previous one. - if Present (Generic_Parent (Parent (Inst))) - and then Is_In_Main_Unit (N) + if Present (Generic_Parent (Par_Inst)) and then Is_In_Main_Unit (N) then declare Enclosing_N : constant Node_Id := Enclosing_Body (N); Par_I : constant Entity_Id := - Previous_Instance - (Generic_Parent (Parent (Inst))); + Previous_Instance (Generic_Parent (Par_Inst)); Scop : Entity_Id; begin @@ -9744,8 +9747,7 @@ package body Sem_Ch12 is if Nkind (Par_N) /= N_Package_Declaration and then Ekind (Inst) = E_Package and then Is_Generic_Instance (Inst) - and then - not In_Same_Source_Unit (Generic_Parent (Parent (Inst)), Inst) + and then not In_Same_Source_Unit (Generic_Parent (Par_Inst), Inst) then while Present (Decl) loop if (Nkind (Decl) in N_Unit_Body @@ -9769,15 +9771,15 @@ package body Sem_Ch12 is end if; end Insert_Freeze_Node_For_Instance; - ------------------ - -- Install_Body -- - ------------------ + ----------------------------- + -- Freeze_Package_Instance -- + ----------------------------- - procedure Install_Body - (Act_Body : Node_Id; - N : Node_Id; + procedure Freeze_Package_Instance + (N : Node_Id; Gen_Body : Node_Id; - Gen_Decl : Node_Id) + Gen_Decl : Node_Id; + Act_Id : Entity_Id) is function In_Same_Scope (Gen_Id, Act_Id : Node_Id) return Boolean; -- Check if the generic definition and the instantiation come from @@ -9838,55 +9840,22 @@ package body Sem_Ch12 is return Res; end True_Sloc; - Act_Id : constant Entity_Id := Corresponding_Spec (Act_Body); + -- Local variables + + Gen_Id : constant Entity_Id := Get_Generic_Entity (N); + Par_Id : constant Entity_Id := Scope (Gen_Id); Act_Unit : constant Node_Id := Unit (Cunit (Get_Source_Unit (N))); - Gen_Id : constant Entity_Id := Corresponding_Spec (Gen_Body); - Par : constant Entity_Id := Scope (Gen_Id); Gen_Unit : constant Node_Id := Unit (Cunit (Get_Source_Unit (Gen_Decl))); Body_Unit : Node_Id; F_Node : Node_Id; Must_Delay : Boolean; - Orig_Body : Node_Id := Gen_Body; + Orig_Body : Node_Id; - -- Start of processing for Install_Body + -- Start of processing for Freeze_Package_Instance begin - -- Handle first the case of an instance with incomplete actual types. - -- The instance body cannot be placed after the declaration because - -- full views have not been seen yet. Any use of the non-limited views - -- in the instance body requires the presence of a regular with_clause - -- in the enclosing unit, and will fail if this with_clause is missing. - -- We place the instance body at the beginning of the enclosing body, - -- which is the unit being compiled. The freeze node for the instance - -- is then placed after the instance body. - - if not Is_Empty_Elmt_List (Incomplete_Actuals (Act_Id)) - and then Expander_Active - and then Ekind (Scope (Act_Id)) = E_Package - then - declare - Scop : constant Entity_Id := Scope (Act_Id); - Body_Id : constant Node_Id := - Corresponding_Body (Unit_Declaration_Node (Scop)); - - begin - Ensure_Freeze_Node (Act_Id); - F_Node := Freeze_Node (Act_Id); - if Present (Body_Id) then - Set_Is_Frozen (Act_Id, False); - Prepend (Act_Body, Declarations (Parent (Body_Id))); - if Is_List_Member (F_Node) then - Remove (F_Node); - end if; - - Insert_After (Act_Body, F_Node); - end if; - end; - return; - end if; - -- If the body is a subunit, the freeze point is the corresponding stub -- in the current compilation, not the subunit itself. @@ -9914,8 +9883,8 @@ package body Sem_Ch12 is and then (Nkind (Gen_Unit) in N_Generic_Package_Declaration | N_Package_Declaration or else (Gen_Unit = Body_Unit - and then True_Sloc (N, Act_Unit) < - Sloc (Orig_Body))) + and then + True_Sloc (N, Act_Unit) < Sloc (Orig_Body))) and then Is_In_Main_Unit (Original_Node (Gen_Unit)) and then In_Same_Scope (Gen_Id, Act_Id)); @@ -9929,9 +9898,8 @@ package body Sem_Ch12 is -- if no delay is needed, we place the freeze node at the end of the -- current declarative part. - if Expander_Active - and then (No (Freeze_Node (Act_Id)) - or else not Is_List_Member (Freeze_Node (Act_Id))) + if No (Freeze_Node (Act_Id)) + or else not Is_List_Member (Freeze_Node (Act_Id)) then Ensure_Freeze_Node (Act_Id); F_Node := Freeze_Node (Act_Id); @@ -9939,14 +9907,14 @@ package body Sem_Ch12 is if Must_Delay then Insert_After (Orig_Body, F_Node); - elsif Is_Generic_Instance (Par) - and then Present (Freeze_Node (Par)) - and then Scope (Act_Id) /= Par + elsif Is_Generic_Instance (Par_Id) + and then Present (Freeze_Node (Par_Id)) + and then Scope (Act_Id) /= Par_Id then -- Freeze instance of inner generic after instance of enclosing -- generic. - if In_Same_Declarative_Part (Parent (Freeze_Node (Par)), N) then + if In_Same_Declarative_Part (Parent (Freeze_Node (Par_Id)), N) then -- Handle the following case: @@ -9971,13 +9939,14 @@ package body Sem_Ch12 is -- of a package declaration, and the inner instance is in -- the corresponding private part. - if Parent (List_Containing (Get_Unit_Instantiation_Node (Par))) + if Parent (List_Containing (Get_Unit_Instantiation_Node + (Par_Id))) = Parent (List_Containing (N)) - and then Sloc (Freeze_Node (Par)) <= Sloc (N) + and then Sloc (Freeze_Node (Par_Id)) <= Sloc (N) then Insert_Freeze_Node_For_Instance (N, F_Node); else - Insert_After (Freeze_Node (Par), F_Node); + Insert_After (Freeze_Node (Par_Id), F_Node); end if; -- Freeze package enclosing instance of inner generic after @@ -9985,7 +9954,7 @@ package body Sem_Ch12 is elsif Nkind (Parent (N)) in N_Package_Body | N_Subprogram_Body and then In_Same_Declarative_Part - (Parent (Freeze_Node (Par)), Parent (N)) + (Parent (Freeze_Node (Par_Id)), Parent (N)) then declare Enclosing : Entity_Id; @@ -10027,15 +9996,15 @@ package body Sem_Ch12 is -- the enclosing package, insert the freeze node after -- the body. - elsif In_Same_List (Freeze_Node (Par), Parent (N)) - and then Sloc (Freeze_Node (Par)) < Sloc (Parent (N)) + elsif In_Same_List (Freeze_Node (Par_Id), Parent (N)) + and then Sloc (Freeze_Node (Par_Id)) < Sloc (Parent (N)) then Insert_Freeze_Node_For_Instance (Parent (N), Freeze_Node (Enclosing)); else Insert_After - (Freeze_Node (Par), Freeze_Node (Enclosing)); + (Freeze_Node (Par_Id), Freeze_Node (Enclosing)); end if; end if; end; @@ -10048,11 +10017,7 @@ package body Sem_Ch12 is Insert_Freeze_Node_For_Instance (N, F_Node); end if; end if; - - Set_Is_Frozen (Act_Id); - Insert_Before (N, Act_Body); - Mark_Rewrite_Insertion (Act_Body); - end Install_Body; + end Freeze_Package_Instance; ----------------------------- -- Install_Formal_Packages -- @@ -12207,7 +12172,7 @@ package body Sem_Ch12 is -- for the elaboration subprogram). if Nkind (Defining_Unit_Name (Act_Spec)) = - N_Defining_Program_Unit_Name + N_Defining_Program_Unit_Name then Set_Scope (Defining_Entity (Inst_Node), Scope (Act_Decl_Id)); end if; @@ -12216,11 +12181,53 @@ package body Sem_Ch12 is -- Case where instantiation is not a library unit else - -- If this is an early instantiation, i.e. appears textually - -- before the corresponding body and must be elaborated first, - -- indicate that the body instance is to be delayed. + -- Handle the case of an instance with incomplete actual types. + -- The instance body cannot be placed just after the declaration + -- because full views have not been seen yet. Any use of the non- + -- limited views in the instance body requires the presence of a + -- regular with_clause in the enclosing unit. Therefore we place + -- the instance body at the beginning of the enclosing body, and + -- the freeze node for the instance is then placed after the body. + + if not Is_Empty_Elmt_List (Incomplete_Actuals (Act_Decl_Id)) + and then Ekind (Scope (Act_Decl_Id)) = E_Package + then + declare + Scop : constant Entity_Id := Scope (Act_Decl_Id); + Body_Id : constant Node_Id := + Corresponding_Body (Unit_Declaration_Node (Scop)); + + F_Node : Node_Id; + + begin + pragma Assert (Present (Body_Id)); - Install_Body (Act_Body, Inst_Node, Gen_Body, Gen_Decl); + Prepend (Act_Body, Declarations (Parent (Body_Id))); + + if Expander_Active then + Ensure_Freeze_Node (Act_Decl_Id); + F_Node := Freeze_Node (Act_Decl_Id); + Set_Is_Frozen (Act_Decl_Id, False); + if Is_List_Member (F_Node) then + Remove (F_Node); + end if; + + Insert_After (Act_Body, F_Node); + end if; + end; + + else + Insert_Before (Inst_Node, Act_Body); + Mark_Rewrite_Insertion (Act_Body); + + -- Insert the freeze node for the instance if need be + + if Expander_Active then + Freeze_Package_Instance + (Inst_Node, Gen_Body, Gen_Decl, Act_Decl_Id); + Set_Is_Frozen (Act_Decl_Id); + end if; + end if; -- If the instantiation appears within a generic child package -- enable visibility of current instance of enclosing generic @@ -12581,11 +12588,14 @@ package body Sem_Ch12 is else Insert_Before (Inst_Node, Pack_Body); Mark_Rewrite_Insertion (Pack_Body); - Analyze (Pack_Body); + + -- Insert the freeze node for the instance if need be if Expander_Active then - Freeze_Subprogram_Body (Inst_Node, Gen_Body, Pack_Id); + Freeze_Subprogram_Instance (Inst_Node, Gen_Body, Pack_Id); end if; + + Analyze (Pack_Body); end if; Inherit_Context (Gen_Body, Inst_Node);