From: Thomas Quinot Date: Thu, 13 Dec 2007 10:29:38 +0000 (+0100) Subject: sem_ch10.adb (Check_Private_Child_Unit): A non-private library level subprogram body... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e116d16c19904addc54c93b3c5b272fb414c2f99;p=gcc.git sem_ch10.adb (Check_Private_Child_Unit): A non-private library level subprogram body that acts as its own spec may not... 2007-12-06 Thomas Quinot Ed Schonberg * sem_ch10.adb (Check_Private_Child_Unit): A non-private library level subprogram body that acts as its own spec may not have a non-private WITH clause on a private sibling. (Build_Unit_Name): If the parent unit in the name in a with_clause on a child unit is a renaming, create an implicit with_clause on that parent, and not on the unit it renames, to prevent visibility errors in the current unit. From-SVN: r130850 --- diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 18e20765706..cc8fcb39063 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -85,7 +85,7 @@ package body Sem_Ch10 is procedure Check_Private_Child_Unit (N : Node_Id); -- If a with_clause mentions a private child unit, the compilation - -- unit must be a member of the same family, as described in 10.1.2 (8). + -- unit must be a member of the same family, as described in 10.1.2. procedure Check_Stub_Level (N : Node_Id); -- Verify that a stub is declared immediately within a compilation unit, @@ -671,9 +671,8 @@ package body Sem_Ch10 is -- Verify that the library unit is a package declaration - if Nkind (Unit (Lib_Unit)) /= N_Package_Declaration - and then - Nkind (Unit (Lib_Unit)) /= N_Generic_Package_Declaration + if not Nkind_In (Unit (Lib_Unit), N_Package_Declaration, + N_Generic_Package_Declaration) then Error_Msg_N ("no legal package declaration for package body", N); @@ -687,8 +686,8 @@ package body Sem_Ch10 is Set_Is_Immediately_Visible (Spec_Id, True); Version_Update (N, Lib_Unit); - if Nkind (Defining_Unit_Name (Unit_Node)) - = N_Defining_Program_Unit_Name + if Nkind (Defining_Unit_Name (Unit_Node)) = + N_Defining_Program_Unit_Name then Generate_Parent_References (Unit_Node, Scope (Spec_Id)); end if; @@ -918,10 +917,10 @@ package body Sem_Ch10 is -- the next compilation, which is either the main unit or some -- other unit in the context. - if Nkind (Unit_Node) = N_Package_Declaration + if Nkind_In (Unit_Node, N_Package_Declaration, + N_Package_Renaming_Declaration, + N_Subprogram_Declaration) or else Nkind (Unit_Node) in N_Generic_Declaration - or else Nkind (Unit_Node) = N_Package_Renaming_Declaration - or else Nkind (Unit_Node) = N_Subprogram_Declaration or else (Nkind (Unit_Node) = N_Subprogram_Body and then Acts_As_Spec (Unit_Node)) @@ -1063,14 +1062,13 @@ package body Sem_Ch10 is -- units manufactured by the compiler never need elab checks. if Comes_From_Source (N) - and then - (Nkind (Unit_Node) = N_Package_Declaration or else - Nkind (Unit_Node) = N_Generic_Package_Declaration or else - Nkind (Unit_Node) = N_Subprogram_Declaration or else - Nkind (Unit_Node) = N_Generic_Subprogram_Declaration) + and then Nkind_In (Unit_Node, N_Package_Declaration, + N_Generic_Package_Declaration, + N_Subprogram_Declaration, + N_Generic_Subprogram_Declaration) then declare - Loc : constant Source_Ptr := Sloc (N); + Loc : constant Source_Ptr := Sloc (N); Unum : constant Unit_Number_Type := Get_Source_Unit (Loc); begin @@ -1305,10 +1303,10 @@ package body Sem_Ch10 is -- Check compilation unit containing the limited-with clause - if Ukind /= N_Package_Declaration - and then Ukind /= N_Subprogram_Declaration - and then Ukind /= N_Package_Renaming_Declaration - and then Ukind /= N_Subprogram_Renaming_Declaration + if not Nkind_In (Ukind, N_Package_Declaration, + N_Subprogram_Declaration, + N_Package_Renaming_Declaration, + N_Subprogram_Renaming_Declaration) and then Ukind not in N_Generic_Declaration and then Ukind not in N_Generic_Renaming_Declaration and then Ukind not in N_Generic_Instantiation @@ -1366,14 +1364,12 @@ package body Sem_Ch10 is and then Nkind (It) = N_With_Clause and then not Limited_Present (It) and then - (Nkind (Unit (Library_Unit (It))) - = N_Package_Declaration - or else - Nkind (Unit (Library_Unit (It))) - = N_Package_Renaming_Declaration) + Nkind_In (Unit (Library_Unit (It)), + N_Package_Declaration, + N_Package_Renaming_Declaration) then - if Nkind (Unit (Library_Unit (It))) - = N_Package_Declaration + if Nkind (Unit (Library_Unit (It))) = + N_Package_Declaration then Unit_Name := Name (It); else @@ -1788,17 +1784,17 @@ package body Sem_Ch10 is -- Verify that the identifier for the stub is unique within this -- declarative part. - if Nkind (Parent (N)) = N_Block_Statement - or else Nkind (Parent (N)) = N_Package_Body - or else Nkind (Parent (N)) = N_Subprogram_Body + if Nkind_In (Parent (N), N_Block_Statement, + N_Package_Body, + N_Subprogram_Body) then Decl := First (Declarations (Parent (N))); while Present (Decl) and then Decl /= N loop if Nkind (Decl) = N_Subprogram_Body_Stub - and then (Chars (Defining_Unit_Name (Specification (Decl))) - = Chars (Defining_Unit_Name (Specification (N)))) + and then (Chars (Defining_Unit_Name (Specification (Decl))) = + Chars (Defining_Unit_Name (Specification (N)))) then Error_Msg_N ("identifier for stub is not unique", N); end if; @@ -2338,7 +2334,7 @@ package body Sem_Ch10 is elsif (Unit_Kind = N_Package_Instantiation or else Nkind (Original_Node (Unit (Library_Unit (N)))) = - N_Package_Instantiation) + N_Package_Instantiation) and then Nkind (U) = N_Package_Body then E_Name := Corresponding_Spec (U); @@ -2485,9 +2481,7 @@ package body Sem_Ch10 is -- Start of processing for Check_Private_Child_Unit begin - if Nkind (Lib_Unit) = N_Package_Body - or else Nkind (Lib_Unit) = N_Subprogram_Body - then + if Nkind_In (Lib_Unit, N_Package_Body, N_Subprogram_Body) then Curr_Unit := Defining_Entity (Unit (Library_Unit (N))); Par_Lib := Curr_Unit; @@ -2589,12 +2583,15 @@ package body Sem_Ch10 is Item, Child_Parent); end if; - elsif not Curr_Private - and then not Private_Present (Item) - and then Nkind (Lib_Unit) /= N_Package_Body - and then Nkind (Lib_Unit) /= N_Subprogram_Body - and then Nkind (Lib_Unit) /= N_Subunit + elsif Curr_Private + or else Private_Present (Item) + or else Nkind_In (Lib_Unit, N_Package_Body, N_Subunit) + or else (Nkind (Lib_Unit) = N_Subprogram_Body + and then not Acts_As_Spec (Parent (Lib_Unit))) then + null; + + else Error_Msg_NE ("current unit must also be private descendant of&", Item, Child_Parent); @@ -2616,12 +2613,11 @@ package body Sem_Ch10 is Kind : constant Node_Kind := Nkind (Par); begin - if (Kind = N_Package_Body - or else Kind = N_Subprogram_Body - or else Kind = N_Task_Body - or else Kind = N_Protected_Body) - and then (Nkind (Parent (Par)) = N_Compilation_Unit - or else Nkind (Parent (Par)) = N_Subunit) + if Nkind_In (Kind, N_Package_Body, + N_Subprogram_Body, + N_Task_Body, + N_Protected_Body) + and then Nkind_In (Parent (Par), N_Compilation_Unit, N_Subunit) then null; @@ -2654,11 +2650,32 @@ package body Sem_Ch10 is --------------------- function Build_Unit_Name (Nam : Node_Id) return Node_Id is - Result : Node_Id; + Renaming : Entity_Id; + Result : Node_Id; begin if Nkind (Nam) = N_Identifier then - return New_Occurrence_Of (Entity (Nam), Loc); + + -- If the parent unit P in the name of the with_clause for P.Q + -- is a renaming of package R, then the entity of the parent is + -- set to R, but the identifier retains Chars (P) to be consistent + -- with the source (see details in lib-load). However, the + -- implicit_with_clause for the parent must make the entity for + -- P visible, because P.Q may be used as a prefix within the + -- current unit. The entity for P is the current_entity with that + -- name, because the package renaming declaration for it has just + -- been analyzed. Note that this case can only happen if P.Q has + -- already appeared in a previous with_clause in a related unit, + -- such as the library body of the current unit. + + if Chars (Nam) /= Chars (Entity (Nam)) then + Renaming := Current_Entity (Nam); + pragma Assert (Renamed_Entity (Renaming) = Entity (Nam)); + return New_Occurrence_Of (Renaming, Loc); + + else + return New_Occurrence_Of (Entity (Nam), Loc); + end if; else Result := @@ -2689,7 +2706,7 @@ package body Sem_Ch10 is -- private. if Nkind (Unit (N)) = N_Package_Declaration then - Set_Private_Present (Withn, Private_Present (Item)); + Set_Private_Present (Withn, Private_Present (Item)); end if; Prepend (Withn, Context_Items (N)); @@ -2952,7 +2969,7 @@ package body Sem_Ch10 is if Nkind (Name (Item)) = N_Expanded_Name then Expand_With_Clause (Item, Prefix (Name (Item)), N); else - -- if not an expanded name, the child unit must be a + -- If not an expanded name, the child unit must be a -- renaming, nothing to do. null; @@ -3110,10 +3127,10 @@ package body Sem_Ch10 is Install_Siblings (Defining_Entity (Unit (Library_Unit (N))), N); end if; - if Nkind (Lib_Unit) = N_Generic_Package_Declaration - or else Nkind (Lib_Unit) = N_Generic_Subprogram_Declaration - or else Nkind (Lib_Unit) = N_Package_Declaration - or else Nkind (Lib_Unit) = N_Subprogram_Declaration + if Nkind_In (Lib_Unit, N_Generic_Package_Declaration, + N_Generic_Subprogram_Declaration, + N_Package_Declaration, + N_Subprogram_Declaration) then if Is_Child_Spec (Lib_Unit) then Lib_Parent := Defining_Entity (Unit (Parent_Spec (Lib_Unit))); @@ -3303,9 +3320,9 @@ package body Sem_Ch10 is elsif not Private_Present (Parent (Item)) and then not Private_Present (Item) - and then Nkind (Unit (Parent (Item))) /= N_Package_Body - and then Nkind (Unit (Parent (Item))) /= N_Subprogram_Body - and then Nkind (Unit (Parent (Item))) /= N_Subunit + and then not Nkind_In (Unit (Parent (Item)), N_Package_Body, + N_Subprogram_Body, + N_Subunit) then Error_Msg_NE ("current unit must also be private descendant of&", @@ -3460,9 +3477,9 @@ package body Sem_Ch10 is then if not Private_Present (Item) or else Private_Present (N) - or else Nkind (Unit (N)) = N_Package_Body - or else Nkind (Unit (N)) = N_Subprogram_Body - or else Nkind (Unit (N)) = N_Subunit + or else Nkind_In (Unit (N), N_Package_Body, + N_Subprogram_Body, + N_Subunit) then Install_Limited_Withed_Unit (Item); end if; @@ -3556,8 +3573,8 @@ package body Sem_Ch10 is end if; if Ekind (P_Name) = E_Generic_Package - and then Nkind (Lib_Unit) /= N_Generic_Subprogram_Declaration - and then Nkind (Lib_Unit) /= N_Generic_Package_Declaration + and then not Nkind_In (Lib_Unit, N_Generic_Subprogram_Declaration, + N_Generic_Package_Declaration) and then Nkind (Lib_Unit) not in N_Generic_Renaming_Declaration then Error_Msg_N @@ -3580,7 +3597,6 @@ package body Sem_Ch10 is -- indicating that we deal with an instance. elsif Nkind (Original_Node (P)) = N_Package_Instantiation then - if Nkind (Lib_Unit) in N_Renaming_Declaration or else Nkind (Original_Node (Lib_Unit)) in N_Generic_Instantiation or else