[Ada] Shadow entity of class-wide types

Message ID	20150512081146.GA14617@adacore.com
State	New
Headers	show Return-Path: <gcc-patches-return-397606-incoming=patchwork.ozlabs.org@gcc.gnu.org> DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=j12FLxD/ZHCif5oW2+YcbDYE+LuC9POXFhZv+B5/fQs+hBxzRx 7L/9v/xX/wqlPAgOPjsnKVjnLULbiWd89Trkj6XIgcPBVblc1obeOtU7TTKo77rW 197B2qkkINoMhVVi75s4u7obH8dlzzUwQTtWaTItN45S96O1nG+5UiB/4= Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org Date: Tue, 12 May 2015 04:11:46 -0400 From: Arnaud Charlet <charlet@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Javier Miranda <miranda@adacore.com> Subject: [Ada] Shadow entity of class-wide types Message-ID: <20150512081146.GA14617@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="0OAP2g/MAC+5xKAE" Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15)

Index: sem_ch5.adb =================================================================== --- sem_ch5.adb (revision 223033) +++ sem_ch5.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -548,9 +548,8 @@ -- types, use the non-limited view if available if Nkind (Rhs) = N_Explicit_Dereference - and then Ekind (T2) = E_Incomplete_Type and then Is_Tagged_Type (T2) - and then Present (Non_Limited_View (T2)) + and then Has_Non_Limited_View (T2) then T2 := Non_Limited_View (T2); end if; Index: sem_type.adb =================================================================== --- sem_type.adb (revision 223033) +++ sem_type.adb (working copy) @@ -1227,34 +1227,18 @@ -- expression may have the limited view. If that one in turn is -- incomplete, get full view if available. - if Is_Incomplete_Type (T1) then - return Covers (Get_Full_View (Non_Limited_View (T1)), T2); + return Has_Non_Limited_View (T1) + and then Covers (Get_Full_View (Non_Limited_View (T1)), T2); - elsif Ekind (T1) = E_Class_Wide_Type then - return - Covers (Class_Wide_Type (Non_Limited_View (Etype (T1))), T2); - else - return False; - end if; - elsif From_Limited_With (T2) then -- If units in the context have Limited_With clauses on each other, -- either type might have a limited view. Checks performed elsewhere -- verify that the context type is the nonlimited view. - if Is_Incomplete_Type (T2) then - return Covers (T1, Get_Full_View (Non_Limited_View (T2))); + return Has_Non_Limited_View (T2) + and then Covers (T1, Get_Full_View (Non_Limited_View (T2))); - elsif Ekind (T2) = E_Class_Wide_Type then - return - Present (Non_Limited_View (Etype (T2))) - and then - Covers (T1, Class_Wide_Type (Non_Limited_View (Etype (T2)))); - else - return False; - end if; - -- Ada 2005 (AI-412): Coverage for regular incomplete subtypes elsif Ekind (T1) = E_Incomplete_Subtype then Index: exp_util.adb =================================================================== --- exp_util.adb (revision 223037) +++ exp_util.adb (working copy) @@ -6874,9 +6874,7 @@ function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id is Desig : constant Entity_Id := Designated_Type (T); begin - if Ekind (Desig) = E_Incomplete_Type - and then Present (Non_Limited_View (Desig)) - then + if Has_Non_Limited_View (Desig) then return Non_Limited_View (Desig); else return Desig; Index: sem_aux.adb =================================================================== --- sem_aux.adb (revision 223033) +++ sem_aux.adb (working copy) @@ -78,31 +78,11 @@ function Available_View (Ent : Entity_Id) return Entity_Id is begin - -- Obtain the non-limited (non-abstract) view of a state or variable + -- Obtain the non-limited view (if available) - if Ekind (Ent) = E_Abstract_State - and then Present (Non_Limited_View (Ent)) - then - return Non_Limited_View (Ent); - - -- The non-limited view of an incomplete type may itself be incomplete - -- in which case obtain its full view. - - elsif Is_Incomplete_Type (Ent) - and then Present (Non_Limited_View (Ent)) - then + if Has_Non_Limited_View (Ent) then return Get_Full_View (Non_Limited_View (Ent)); - -- If it is class_wide, check whether the specific type comes from a - -- limited_with. - - elsif Is_Class_Wide_Type (Ent) - and then Is_Incomplete_Type (Etype (Ent)) - and then From_Limited_With (Etype (Ent)) - and then Present (Non_Limited_View (Etype (Ent))) - then - return Class_Wide_Type (Non_Limited_View (Etype (Ent))); - -- In all other cases, return entity unchanged else Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 223033) +++ exp_attr.adb (working copy) @@ -1787,21 +1787,10 @@ -- Handle designated types that come from the limited view - if Ekind (Btyp_DDT) = E_Incomplete_Type - and then From_Limited_With (Btyp_DDT) - and then Present (Non_Limited_View (Btyp_DDT)) + if From_Limited_With (Btyp_DDT) + and then Has_Non_Limited_View (Btyp_DDT) then Btyp_DDT := Non_Limited_View (Btyp_DDT); - - elsif Is_Class_Wide_Type (Btyp_DDT) - and then Ekind (Etype (Btyp_DDT)) = E_Incomplete_Type - and then From_Limited_With (Etype (Btyp_DDT)) - and then Present (Non_Limited_View (Etype (Btyp_DDT))) - and then Present (Class_Wide_Type - (Non_Limited_View (Etype (Btyp_DDT)))) - then - Btyp_DDT := - Class_Wide_Type (Non_Limited_View (Etype (Btyp_DDT))); end if; -- In order to improve the text of error messages, the designated Index: sem_ch10.adb =================================================================== --- sem_ch10.adb (revision 223033) +++ sem_ch10.adb (working copy) @@ -5604,6 +5604,11 @@ Decorate_Type (Shadow, Scop, Is_Tagged); Set_Non_Limited_View (Shadow, Ent); + if Is_Tagged then + Set_Non_Limited_View (Class_Wide_Type (Shadow), + Class_Wide_Type (Ent)); + end if; + if Is_Incomplete_Or_Private_Type (Ent) then Set_Private_Dependents (Shadow, New_Elmt_List); end if; @@ -5671,35 +5676,33 @@ Set_Is_Tagged_Type (Ent); Set_Direct_Primitive_Operations (Ent, New_Elmt_List); - if No (Class_Wide_Type (Ent)) then - CW_Typ := - New_External_Entity - (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); + CW_Typ := + New_External_Entity + (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); - Set_Class_Wide_Type (Ent, CW_Typ); + Set_Class_Wide_Type (Ent, CW_Typ); - -- Set parent to be the same as the parent of the tagged type. - -- We need a parent field set, and it is supposed to point to - -- the declaration of the type. The tagged type declaration - -- essentially declares two separate types, the tagged type - -- itself and the corresponding class-wide type, so it is - -- reasonable for the parent fields to point to the declaration - -- in both cases. + -- Set parent to be the same as the parent of the tagged type. + -- We need a parent field set, and it is supposed to point to + -- the declaration of the type. The tagged type declaration + -- essentially declares two separate types, the tagged type + -- itself and the corresponding class-wide type, so it is + -- reasonable for the parent fields to point to the declaration + -- in both cases. - Set_Parent (CW_Typ, Parent (Ent)); + Set_Parent (CW_Typ, Parent (Ent)); - Set_Ekind (CW_Typ, E_Class_Wide_Type); - Set_Etype (CW_Typ, Ent); - Set_Scope (CW_Typ, Scop); - Set_Is_Tagged_Type (CW_Typ); - Set_Is_First_Subtype (CW_Typ); - Init_Size_Align (CW_Typ); - Set_Has_Unknown_Discriminants (CW_Typ); - Set_Class_Wide_Type (CW_Typ, CW_Typ); - Set_Equivalent_Type (CW_Typ, Empty); - Set_From_Limited_With (CW_Typ, From_Limited_With (Ent)); - Set_Materialize_Entity (CW_Typ, Materialize); - end if; + Set_Ekind (CW_Typ, E_Class_Wide_Type); + Set_Etype (CW_Typ, Ent); + Set_Scope (CW_Typ, Scop); + Set_Is_Tagged_Type (CW_Typ); + Set_Is_First_Subtype (CW_Typ); + Init_Size_Align (CW_Typ); + Set_Has_Unknown_Discriminants (CW_Typ); + Set_Class_Wide_Type (CW_Typ, CW_Typ); + Set_Equivalent_Type (CW_Typ, Empty); + Set_From_Limited_With (CW_Typ, From_Limited_With (Ent)); + Set_Materialize_Entity (CW_Typ, Materialize); end if; end Decorate_Type; Index: einfo.adb =================================================================== --- einfo.adb (revision 223033) +++ einfo.adb (working copy) @@ -146,7 +146,6 @@ -- First_Literal Node17 -- Master_Id Node17 -- Modulus Uint17 - -- Non_Limited_View Node17 -- Prival Node17 -- Alias Node18 @@ -168,6 +167,7 @@ -- Default_Aspect_Value Node19 -- Entry_Bodies_Array Node19 -- Extra_Accessibility_Of_Result Node19 + -- Non_Limited_View Node19 -- Parent_Subtype Node19 -- Size_Check_Code Node19 -- Spec_Entity Node19 @@ -2683,8 +2683,10 @@ function Non_Limited_View (Id : E) return E is begin pragma Assert - (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State); - return Node17 (Id); + (Ekind (Id) in Incomplete_Kind + or else Ekind (Id) in Class_Wide_Kind + or else Ekind (Id) = E_Abstract_State); + return Node19 (Id); end Non_Limited_View; function Nonzero_Is_True (Id : E) return B is @@ -5629,8 +5631,10 @@ procedure Set_Non_Limited_View (Id : E; V : E) is begin pragma Assert - (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State); - Set_Node17 (Id, V); + (Ekind (Id) in Incomplete_Kind + or else Ekind (Id) = E_Abstract_State + or else Ekind (Id) = E_Class_Wide_Type); + Set_Node19 (Id, V); end Set_Non_Limited_View; procedure Set_Nonzero_Is_True (Id : E; V : B := True) is @@ -7105,6 +7109,18 @@ return False; end Has_Interrupt_Handler; + -------------------------- + -- Has_Non_Limited_View -- + -------------------------- + + function Has_Non_Limited_View (Id : E) return B is + begin + return (Ekind (Id) in Incomplete_Kind + or else Ekind (Id) in Class_Wide_Kind + or else Ekind (Id) = E_Abstract_State) + and then Present (Non_Limited_View (Id)); + end Has_Non_Limited_View; + ----------------------------- -- Has_Non_Null_Refinement -- ----------------------------- @@ -9390,10 +9406,6 @@ when Modular_Integer_Kind => Write_Str ("Modulus"); - when E_Abstract_State | - E_Incomplete_Type => - Write_Str ("Non_Limited_View"); - when E_Incomplete_Subtype => if From_Limited_With (Id) then Write_Str ("Non_Limited_View"); @@ -9489,6 +9501,11 @@ when Scalar_Kind => Write_Str ("Default_Aspect_Value"); + when E_Abstract_State | + E_Class_Wide_Type | + E_Incomplete_Type => + Write_Str ("Non_Limited_View"); + when E_Array_Type => Write_Str ("Default_Component_Value"); Index: einfo.ads =================================================================== --- einfo.ads (revision 223033) +++ einfo.ads (working copy) @@ -1706,7 +1706,12 @@ -- Defined in subprogram entities. Set for a subprogram which contains at -- least one nested subprogram. - -- Has_Non_Null_Refinement (synth) +-- Has_Non_Limited_View (synth) +-- Defined in E_Incomplete_Type, E_Incomplete_Subtype, E_Class_Wide_Type, +-- E_Abstract_State entities. True if their Non_Limited_View attribute +-- is present. + +-- Has_Non_Null_Refinement (synth) -- Defined in E_Abstract_State entities. True if the state has at least -- one variable or state constituent in aspect/pragma Refined_State. @@ -3449,7 +3454,7 @@ -- Defined in all subtype and type entities. Set for modular integer -- types if the modulus value is other than a power of 2. --- Non_Limited_View (Node17) +-- Non_Limited_View (Node19) -- Defined in abstract states and incomplete types that act as shadow -- entities created when analysing a limited with clause (Ada 2005: -- AI-50217). Points to the defining entity of the original declaration. @@ -5445,9 +5450,10 @@ -- Part_Of_Constituents (Elist9) -- Encapsulating_State (Node10) -- Body_References (Elist16) - -- Non_Limited_View (Node17) + -- Non_Limited_View (Node19) -- From_Limited_With (Flag159) -- Has_Visible_Refinement (Flag263) + -- Has_Non_Limited_View (synth) -- Has_Non_Null_Refinement (synth) -- Has_Null_Refinement (synth) -- Is_External_State (synth) @@ -5548,10 +5554,12 @@ -- First_Entity (Node17) -- Equivalent_Type (Node18) (always Empty for type) -- Last_Entity (Node20) + -- Non_Limited_View (Node19) -- SSO_Set_High_By_Default (Flag273) (base type only) -- SSO_Set_Low_By_Default (Flag272) (base type only) -- First_Component (synth) -- First_Component_Or_Discriminant (synth) + -- Has_Non_Limited_View (synth) -- (plus type attributes) -- E_Component @@ -5867,10 +5875,11 @@ -- E_Incomplete_Type -- E_Incomplete_Subtype -- Direct_Primitive_Operations (Elist10) - -- Non_Limited_View (Node17) + -- Non_Limited_View (Node19) -- Private_Dependents (Elist18) -- Discriminant_Constraint (Elist21) -- Stored_Constraint (Elist23) + -- Has_Non_Limited_View (synth) -- (plus type attributes) -- E_In_Parameter @@ -7123,6 +7132,7 @@ function Has_Attach_Handler (Id : E) return B; function Has_Entries (Id : E) return B; function Has_Foreign_Convention (Id : E) return B; + function Has_Non_Limited_View (Id : E) return B; function Has_Non_Null_Refinement (Id : E) return B; function Has_Null_Abstract_State (Id : E) return B; function Has_Null_Refinement (Id : E) return B; Index: freeze.adb =================================================================== --- freeze.adb (revision 223033) +++ freeze.adb (working copy) @@ -424,9 +424,7 @@ declare Ret_Type : constant Entity_Id := Etype (Result_Definition (Spec)); begin - if Ekind (Ret_Type) = E_Incomplete_Type - and then Present (Non_Limited_View (Ret_Type)) - then + if Has_Non_Limited_View (Ret_Type) then Set_Result_Definition (Spec, New_Occurrence_Of (Non_Limited_View (Ret_Type), Loc)); end if; Index: sem_util.adb =================================================================== --- sem_util.adb (revision 223035) +++ sem_util.adb (working copy) @@ -4941,7 +4941,7 @@ -- Both names are selected_components, their prefixes are known to -- denote the same object, and their selector_names denote the same - -- component (RM 6.4.1(6.6/3) + -- component (RM 6.4.1(6.6/3)) elsif Nkind (Obj1) = N_Selected_Component then return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2)) Index: sem_res.adb =================================================================== --- sem_res.adb (revision 223033) +++ sem_res.adb (working copy) @@ -10744,19 +10744,11 @@ -- view when available. If it is a class-wide type, recover the -- class-wide type of the nonlimited view. - if From_Limited_With (Opnd) then - if Ekind (Opnd) in Incomplete_Kind - and then Present (Non_Limited_View (Opnd)) - then - Opnd := Non_Limited_View (Opnd); - Set_Etype (Expression (N), Opnd); - - elsif Is_Class_Wide_Type (Opnd) - and then Present (Non_Limited_View (Etype (Opnd))) - then - Opnd := Class_Wide_Type (Non_Limited_View (Etype (Opnd))); - Set_Etype (Expression (N), Opnd); - end if; + if From_Limited_With (Opnd) + and then Has_Non_Limited_View (Opnd) + then + Opnd := Non_Limited_View (Opnd); + Set_Etype (Expression (N), Opnd); end if; if Is_Access_Type (Opnd) then @@ -12342,9 +12334,8 @@ begin -- Handle the limited view of a type - if Is_Incomplete_Type (Desig) - and then From_Limited_With (Desig) - and then Present (Non_Limited_View (Desig)) + if From_Limited_With (Desig) + and then Has_Non_Limited_View (Desig) then return Available_View (Desig); else Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 223036) +++ sem_ch4.adb (working copy) @@ -4116,26 +4116,14 @@ -- If the non-limited view is itself an incomplete type, get the -- full view if available. - if Is_Incomplete_Type (Prefix_Type) - and then From_Limited_With (Prefix_Type) - and then Present (Non_Limited_View (Prefix_Type)) + if From_Limited_With (Prefix_Type) + and then Has_Non_Limited_View (Prefix_Type) then Prefix_Type := Get_Full_View (Non_Limited_View (Prefix_Type)); if Nkind (N) = N_Explicit_Dereference then Set_Etype (Prefix (N), Prefix_Type); end if; - - elsif Ekind (Prefix_Type) = E_Class_Wide_Type - and then From_Limited_With (Prefix_Type) - and then Present (Non_Limited_View (Etype (Prefix_Type))) - then - Prefix_Type := - Class_Wide_Type (Non_Limited_View (Etype (Prefix_Type))); - - if Nkind (N) = N_Explicit_Dereference then - Set_Etype (Prefix (N), Prefix_Type); - end if; end if; if Ekind (Prefix_Type) = E_Private_Subtype then @@ -7976,6 +7964,7 @@ if Ekind (Obj_Type) = E_Incomplete_Type and then From_Limited_With (Obj_Type) + and then Has_Non_Limited_View (Obj_Type) then Obj_Type := Get_Full_View (Non_Limited_View (Obj_Type)); end if; Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 223033) +++ sem_ch6.adb (working copy) @@ -2923,9 +2923,8 @@ Typ : constant Entity_Id := Etype (Id); begin - if Ekind (Typ) = E_Incomplete_Type - and then From_Limited_With (Typ) - and then Present (Non_Limited_View (Typ)) + if From_Limited_With (Typ) + and then Has_Non_Limited_View (Typ) then Set_Etype (Id, Non_Limited_View (Typ)); end if; Index: exp_disp.adb =================================================================== --- exp_disp.adb (revision 223033) +++ exp_disp.adb (working copy) @@ -1605,9 +1605,7 @@ -- a duplicate declaration whose designated type is the -- non-limited view. - if Ekind (Actual_DDT) = E_Incomplete_Type - and then Present (Non_Limited_View (Actual_DDT)) - then + if Has_Non_Limited_View (Actual_DDT) then Anon := New_Copy (Actual_Typ); if Is_Itype (Anon) then @@ -1617,27 +1615,6 @@ Set_Directly_Designated_Type (Anon, Non_Limited_View (Actual_DDT)); Set_Etype (Actual_Dup, Anon); - - elsif Is_Class_Wide_Type (Actual_DDT) - and then Ekind (Etype (Actual_DDT)) = E_Incomplete_Type - and then Present (Non_Limited_View (Etype (Actual_DDT))) - then - Anon := New_Copy (Actual_Typ); - - if Is_Itype (Anon) then - Set_Scope (Anon, Current_Scope); - end if; - - Set_Directly_Designated_Type (Anon, - New_Copy (Actual_DDT)); - Set_Class_Wide_Type (Directly_Designated_Type (Anon), - New_Copy (Class_Wide_Type (Actual_DDT))); - Set_Etype (Directly_Designated_Type (Anon), - Non_Limited_View (Etype (Actual_DDT))); - Set_Etype ( - Class_Wide_Type (Directly_Designated_Type (Anon)), - Non_Limited_View (Etype (Actual_DDT))); - Set_Etype (Actual_Dup, Anon); end if; end if; Index: sem_ch8.adb =================================================================== --- sem_ch8.adb (revision 223035) +++ sem_ch8.adb (working copy) @@ -5767,18 +5767,20 @@ end if; end if; - -- Ada 2005 (AI-217): Handle shadow entities associated with types - -- declared in limited-withed nested packages. We don't need to - -- handle E_Incomplete_Subtype entities because the entities in - -- the limited view are always E_Incomplete_Type entities (see - -- Build_Limited_Views). Regarding the expression used to evaluate - -- the scope, it is important to note that the limited view also - -- has shadow entities associated nested packages. For this reason - -- the correct scope of the entity is the scope of the real entity + -- Ada 2005 (AI-217): Handle shadow entities associated with + -- types declared in limited-withed nested packages. We don't need + -- to handle E_Incomplete_Subtype entities because the entities + -- in the limited view are always E_Incomplete_Type and + -- E_Class_Wide_Type entities (see Build_Limited_Views). + + -- Regarding the expression used to evaluate the scope, it + -- is important to note that the limited view also has shadow + -- entities associated nested packages. For this reason the + -- correct scope of the entity is the scope of the real entity. -- The non-limited view may itself be incomplete, in which case -- get the full view if available. - elsif Ekind (Id) = E_Incomplete_Type + elsif Ekind_In (Id, E_Incomplete_Type, E_Class_Wide_Type) and then From_Limited_With (Id) and then Present (Non_Limited_View (Id)) and then Scope (Non_Limited_View (Id)) = P_Name @@ -6725,17 +6727,15 @@ -- The designated type may be a limited view with no components. -- Check whether the non-limited view is available, because in some - -- cases this will not be set when instlling the context. + -- cases this will not be set when installing the context. if Is_Access_Type (P_Type) then declare D : constant Entity_Id := Directly_Designated_Type (P_Type); begin if Is_Incomplete_Type (D) - and then not Is_Class_Wide_Type (D) and then From_Limited_With (D) and then Present (Non_Limited_View (D)) - and then not Is_Class_Wide_Type (Non_Limited_View (D)) then Set_Directly_Designated_Type (P_Type, Non_Limited_View (D)); end if; Index: sem_disp.adb =================================================================== --- sem_disp.adb (revision 223033) +++ sem_disp.adb (working copy) @@ -336,7 +336,7 @@ -- Ada 2005 (AI-50217) elsif From_Limited_With (Designated_Type (T)) - and then Present (Non_Limited_View (Designated_Type (T))) + and then Has_Non_Limited_View (Designated_Type (T)) and then Scope (Designated_Type (T)) = Scope (Subp) then if Is_First_Subtype (Non_Limited_View (Designated_Type (T))) then

[Ada] Shadow entity of class-wide types

Commit Message

Patch