From c0985d4ed8bc79ad6cafed12f7fa3089d13879ae Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 23 Jun 2009 10:15:47 +0000 Subject: sem_attr.adb: Add with and use clauses for Sem_Ch10. 2009-06-23 Hristian Kirtchev * sem_attr.adb: Add with and use clauses for Sem_Ch10. (Check_Not_Incomplete_Type): Minor reformatting. Retrieve the root type when dealing with class-wide types. Detect a legal shadow entity and retrieve its non-limited view. * sem_ch10.adb (Has_With_Clause): Move the spec and body of the subprogram to top package level from Intall_Limited_Withed_Unit. (Install_Limited_Withed_Unit): Remove spec and body of Has_With_Clause. Add check which prevents the installation of a limited view if the non-limited view is already visible through a with clause. (Is_Legal_Shadow_Entity_In_Body): New routine. Detect a residual, but legal shadow entity which may occur in subprogram formals of anonymous access type. * sem_ch10.ads (Is_Legal_Shadow_Entity_In_Body): New routine. * sem_ch3.adb (Access_Definition): Remove the propagation of flag From_With_Type from the designated type to the generated anonymous access type. Remove associated comment. * sem_res.adb Add with and use clauses for Sem_Ch10. (Full_Designated_Type): Detect a legal shadow entity and retrieve its non-limited view. Since the shadow entity may replace a regular incomplete type, return the available full view. From-SVN: r148844 --- gcc/ada/ChangeLog | 27 +++++++++++ gcc/ada/sem_attr.adb | 28 +++++++++-- gcc/ada/sem_ch10.adb | 129 ++++++++++++++++++++++++++++----------------------- gcc/ada/sem_ch10.ads | 7 ++- gcc/ada/sem_ch3.adb | 18 +++---- gcc/ada/sem_res.adb | 17 ++++--- 6 files changed, 145 insertions(+), 81 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8546e6f..d0c9c6c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2009-06-23 Hristian Kirtchev + + * sem_attr.adb: Add with and use clauses for Sem_Ch10. + (Check_Not_Incomplete_Type): Minor reformatting. Retrieve the root type + when dealing with class-wide types. Detect a legal shadow entity and + retrieve its non-limited view. + + * sem_ch10.adb (Has_With_Clause): Move the spec and body of the + subprogram to top package level from Intall_Limited_Withed_Unit. + (Install_Limited_Withed_Unit): Remove spec and body of Has_With_Clause. + Add check which prevents the installation of a limited view if the + non-limited view is already visible through a with clause. + (Is_Legal_Shadow_Entity_In_Body): New routine. Detect a residual, but + legal shadow entity which may occur in subprogram formals of anonymous + access type. + + * sem_ch10.ads (Is_Legal_Shadow_Entity_In_Body): New routine. + + * sem_ch3.adb (Access_Definition): Remove the propagation of flag + From_With_Type from the designated type to the generated anonymous + access type. Remove associated comment. + + * sem_res.adb Add with and use clauses for Sem_Ch10. + (Full_Designated_Type): Detect a legal shadow entity and retrieve its + non-limited view. Since the shadow entity may replace a regular + incomplete type, return the available full view. + 2009-06-23 Ed Schonberg * sem_ch10.adb (Remove_Limited_With_Clause): Clean up code that handles diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 51536ae..bc68b86 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -51,6 +51,7 @@ with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch10; use Sem_Ch10; with Sem_Dist; use Sem_Dist; with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; @@ -1345,15 +1346,32 @@ package body Sem_Attr is E := Prefix (E); end loop; - if From_With_Type (Etype (E)) then + Typ := Etype (E); + + if From_With_Type (Typ) then Error_Attr_P ("prefix of % attribute cannot be an incomplete type"); else - if Is_Access_Type (Etype (E)) then - Typ := Directly_Designated_Type (Etype (E)); - else - Typ := Etype (E); + if Is_Access_Type (Typ) then + Typ := Directly_Designated_Type (Typ); + end if; + + if Is_Class_Wide_Type (Typ) then + Typ := Root_Type (Typ); + end if; + + -- A legal use of a shadow entity occurs only when the unit + -- where the non-limited view resides is imported via a regular + -- with clause in the current body. Such references to shadow + -- entities may occur in subprogram formals. + + if Is_Incomplete_Type (Typ) + and then From_With_Type (Typ) + and then Present (Non_Limited_View (Typ)) + and then Is_Legal_Shadow_Entity_In_Body (Typ) + then + Typ := Non_Limited_View (Typ); end if; if Ekind (Typ) = E_Incomplete_Type diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 8ae44ff..72a0c67 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -108,6 +108,13 @@ package body Sem_Ch10 is -- has not yet been rewritten as a package declaration, and the entity has -- to be retrieved from the Instance_Spec of the unit. + function Has_With_Clause + (C_Unit : Node_Id; + Pack : Entity_Id; + Is_Limited : Boolean := False) return Boolean; + -- Determine whether compilation unit C_Unit contains a with clause for + -- package Pack. Use flag Is_Limited to designate desired clause kind. + procedure Implicit_With_On_Parent (Child_Unit : Node_Id; N : Node_Id); -- If the main unit is a child unit, implicit withs are also added for -- all its ancestors. @@ -2802,6 +2809,49 @@ package body Sem_Ch10 is end if; end Get_Parent_Entity; + --------------------- + -- Has_With_Clause -- + --------------------- + + function Has_With_Clause + (C_Unit : Node_Id; + Pack : Entity_Id; + Is_Limited : Boolean := False) return Boolean + is + Item : Node_Id; + Nam : Entity_Id; + + begin + if Present (Context_Items (C_Unit)) then + Item := First (Context_Items (C_Unit)); + while Present (Item) loop + if Nkind (Item) = N_With_Clause then + + -- Retrieve the entity of the imported compilation unit + + if Nkind (Name (Item)) = N_Selected_Component then + Nam := Entity (Selector_Name (Name (Item))); + else + Nam := Entity (Name (Item)); + end if; + + if Nam = Pack + and then + ((Is_Limited and then Limited_Present (Item)) + or else + (not Is_Limited and then not Limited_Present (Item))) + then + return True; + end if; + end if; + + Next (Item); + end loop; + end if; + + return False; + end Has_With_Clause; + ----------------------------- -- Implicit_With_On_Parent -- ----------------------------- @@ -3558,12 +3608,6 @@ package body Sem_Ch10 is Install_Limited_Withed_Unit (Item); end if; end if; - - -- All items other than Limited_With clauses are ignored (they were - -- installed separately early on by Install_Context_Clause). - - else - null; end if; Next (Item); @@ -3913,14 +3957,6 @@ package body Sem_Ch10 is -- Determine whether any package in the ancestor chain starting with -- C_Unit has a limited with clause for package Pack. - function Has_With_Clause - (C_Unit : Node_Id; - Pack : Entity_Id; - Is_Limited : Boolean := False) return Boolean; - -- Determine whether compilation unit C_Unit contains a with clause - -- for package Pack. Use flag Is_Limited to designate desired clause - -- kind. This is a subsidiary routine to Has_Limited_With_Clause. - function Is_Visible_Through_Renamings (P : Entity_Id) return Boolean; -- Check if some package installed though normal with-clauses has a -- renaming declaration of package P. AARM 10.1.2(21/2). @@ -4253,49 +4289,6 @@ package body Sem_Ch10 is return False; end Has_Limited_With_Clause; - --------------------- - -- Has_With_Clause -- - --------------------- - - function Has_With_Clause - (C_Unit : Node_Id; - Pack : Entity_Id; - Is_Limited : Boolean := False) return Boolean - is - Item : Node_Id; - Nam : Entity_Id; - - begin - if Present (Context_Items (C_Unit)) then - Item := First (Context_Items (C_Unit)); - while Present (Item) loop - if Nkind (Item) = N_With_Clause then - - -- Retrieve the entity of the imported compilation unit - - if Nkind (Name (Item)) = N_Selected_Component then - Nam := Entity (Selector_Name (Name (Item))); - else - Nam := Entity (Name (Item)); - end if; - - if Nam = Pack - and then - ((Is_Limited and then Limited_Present (Item)) - or else - (not Is_Limited and then not Limited_Present (Item))) - then - return True; - end if; - end if; - - Next (Item); - end loop; - end if; - - return False; - end Has_With_Clause; - ---------------------------------- -- Is_Visible_Through_Renamings -- ---------------------------------- @@ -4423,6 +4416,15 @@ package body Sem_Ch10 is P := Defining_Identifier (P); end if; + -- Do not install the limited-view if the context of the unit is already + -- available through a regular with clause. + + if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body + and then Has_With_Clause (Cunit (Current_Sem_Unit), P) + then + return; + end if; + -- Do not install the limited-view if the full-view is already visible -- through renaming declarations. @@ -4907,6 +4909,19 @@ package body Sem_Ch10 is and then Present (Parent_Spec (Lib_Unit)); end Is_Child_Spec; + ------------------------------------ + -- Is_Legal_Shadow_Entity_In_Body -- + ------------------------------------ + + function Is_Legal_Shadow_Entity_In_Body (T : Entity_Id) return Boolean is + C_Unit : constant Node_Id := Cunit (Current_Sem_Unit); + + begin + return Nkind (Unit (C_Unit)) = N_Package_Body + and then Has_With_Clause (C_Unit, + Cunit_Entity (Get_Source_Unit (Non_Limited_View (T)))); + end Is_Legal_Shadow_Entity_In_Body; + ----------------------- -- Load_Needed_Body -- ----------------------- diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads index 066ceec..9bf19ed 100644 --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -43,6 +43,11 @@ package Sem_Ch10 is -- its private part, compiling a private child unit, or compiling the -- private declarations of a public child unit. + function Is_Legal_Shadow_Entity_In_Body (T : Entity_Id) return Boolean; + -- Assuming that type T is an incomplete type coming from a limited with + -- view, determine whether the package where T resides is imported through + -- a regular with clause in the current package body. + procedure Remove_Context (N : Node_Id); -- Removes the entities from the context clause of the given compilation -- unit from the visibility chains. This is done on exit from a unit as diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index df1a500..7479d75 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -840,8 +840,8 @@ package body Sem_Ch3 is Desig_Type := Entity (Subtype_Mark (N)); Set_Directly_Designated_Type - (Anon_Type, Desig_Type); - Set_Etype (Anon_Type, Anon_Type); + (Anon_Type, Desig_Type); + Set_Etype (Anon_Type, Anon_Type); -- Make sure the anonymous access type has size and alignment fields -- set, as required by gigi. This is necessary in the case of the @@ -873,11 +873,6 @@ package body Sem_Ch3 is Set_Is_Public (Anon_Type, Is_Public (Scope (Anon_Type))); - -- Ada 2005 (AI-50217): Propagate the attribute that indicates that the - -- designated type comes from the limited view. - - Set_From_With_Type (Anon_Type, From_With_Type (Desig_Type)); - -- Ada 2005 (AI-231): Propagate the access-constant attribute Set_Is_Access_Constant (Anon_Type, Constant_Present (N)); @@ -960,7 +955,7 @@ package body Sem_Ch3 is -- introduce semantic dependencies. elsif Nkind (Related_Nod) = N_Function_Specification - and then not From_With_Type (Anon_Type) + and then not From_With_Type (Desig_Type) then if Present (Enclosing_Prot_Type) then Build_Itype_Reference (Anon_Type, Parent (Enclosing_Prot_Type)); @@ -12046,11 +12041,10 @@ package body Sem_Ch3 is elsif Chars (Parent_Subp) = Name_Op_Eq and then Is_Dispatching_Operation (Parent_Subp) and then Etype (Parent_Subp) = Standard_Boolean + and then not Is_Limited_Type (Etype (First_Formal (Parent_Subp))) and then - not Is_Limited_Type (Etype (First_Formal (Parent_Subp))) - and then - Etype (First_Formal (Parent_Subp)) - = Etype (Next_Formal (First_Formal (Parent_Subp))) + Etype (First_Formal (Parent_Subp)) = + Etype (Next_Formal (First_Formal (Parent_Subp))) then Set_Derived_Name; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e1a934b..e2c6103 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -57,6 +57,7 @@ with Sem_Cat; use Sem_Cat; with Sem_Ch4; use Sem_Ch4; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch10; use Sem_Ch10; with Sem_Ch13; use Sem_Ch13; with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; @@ -9619,16 +9620,20 @@ package body Sem_Res is -------------------------- function Full_Designated_Type (T : Entity_Id) return Entity_Id is - Desig : constant Entity_Id := Designated_Type (T); + Desig : Entity_Id := Designated_Type (T); + begin - if From_With_Type (Desig) - and then Is_Incomplete_Type (Desig) + -- Detect a legal use of a shadow entity + + if Is_Incomplete_Type (Desig) + and then From_With_Type (Desig) and then Present (Non_Limited_View (Desig)) + and then Is_Legal_Shadow_Entity_In_Body (Desig) then - return Non_Limited_View (Desig); - else - return Desig; + Desig := Non_Limited_View (Desig); end if; + + return Available_View (Desig); end Full_Designated_Type; -- Local Declarations -- cgit v1.1