From: Arnaud Charlet Date: Tue, 12 May 2015 08:11:25 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=473469230a0224c19584317db7c2b9e9bb07c5c1;p=gcc.git [multiple changes] 2015-05-12 Robert Dewar * exp_prag.adb (Expand_N_Pragma): Rewrite ignored pragma as Null statements. * namet.ads (Boolean3): Document this flag used for Ignore_Pragma. * par-prag.adb (Prag): Implement Ignore_Pragma. * sem_prag.adb: Implement Ignore_Pragma. * snames.ads-tmpl: Add entries for pragma Ignore_Pragma. 2015-05-12 Javier Miranda * sem_ch10.adb (Build_Shadow_Entity): Link the class-wide shadow entity with its corresponding real entity. (Decorate_Type): Unconditionally build the class-wide shadow entity of tagged types. * einfo.ads, einfo.adb (Has_Non_Limited_View): New synthesized attribute. (Non_Limited_View): Moved from field 17 to field 19 be available in class-wide entities. * exp_attr.adb (Access_Cases): Code cleanup. * exp_disp.adb (Expand_Interface_Actuals): Ditto. * exp_util.adb (Non_Limited_Designated_Type): Ditto. * freeze.adb (Build_Renamed_Bdody): Ditto. * sem_aux.adb (Available_View): Ditto. * sem_ch4.adb (Analyze_Selected_Component): Ditto. (Try_One_Prefix_Interpretation): Ditto. * sem_ch5.adb (Analyze_Assignment): Ditto. * sem_ch6.adb (Detect_And_Exchange): Ditto. * sem_ch8.adb (Find_Expanded_Name): Ditto. * sem_disp.adb (Check_Controlling_Type): Ditto. * sem_res.adb (Resolve_Type_Conversion): Ditto. (Full_Designated_Type): Ditto. * sem_type.adb (Covers): Ditto. * sem_util.adb: Fix typo in comment. From-SVN: r223038 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e2666c62709..5de8f002659 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,38 @@ +2015-05-12 Robert Dewar + + * exp_prag.adb (Expand_N_Pragma): Rewrite ignored pragma as + Null statements. + * namet.ads (Boolean3): Document this flag used for Ignore_Pragma. + * par-prag.adb (Prag): Implement Ignore_Pragma. + * sem_prag.adb: Implement Ignore_Pragma. + * snames.ads-tmpl: Add entries for pragma Ignore_Pragma. + +2015-05-12 Javier Miranda + + * sem_ch10.adb (Build_Shadow_Entity): Link the class-wide shadow + entity with its corresponding real entity. + (Decorate_Type): Unconditionally build the class-wide shadow entity of + tagged types. + * einfo.ads, einfo.adb (Has_Non_Limited_View): New synthesized + attribute. + (Non_Limited_View): Moved from field 17 to field 19 be available + in class-wide entities. + * exp_attr.adb (Access_Cases): Code cleanup. + * exp_disp.adb (Expand_Interface_Actuals): Ditto. + * exp_util.adb (Non_Limited_Designated_Type): Ditto. + * freeze.adb (Build_Renamed_Bdody): Ditto. + * sem_aux.adb (Available_View): Ditto. + * sem_ch4.adb (Analyze_Selected_Component): Ditto. + (Try_One_Prefix_Interpretation): Ditto. + * sem_ch5.adb (Analyze_Assignment): Ditto. + * sem_ch6.adb (Detect_And_Exchange): Ditto. + * sem_ch8.adb (Find_Expanded_Name): Ditto. + * sem_disp.adb (Check_Controlling_Type): Ditto. + * sem_res.adb (Resolve_Type_Conversion): Ditto. + (Full_Designated_Type): Ditto. + * sem_type.adb (Covers): Ditto. + * sem_util.adb: Fix typo in comment. + 2015-05-12 Robert Dewar * exp_unst.adb (Get_Real_Subp): New subprogram. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 511ba3a0a33..2e7d51980c7 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -146,7 +146,6 @@ package body Einfo is -- First_Literal Node17 -- Master_Id Node17 -- Modulus Uint17 - -- Non_Limited_View Node17 -- Prival Node17 -- Alias Node18 @@ -168,6 +167,7 @@ package body Einfo is -- 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 @@ package body Einfo is 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 @@ package body Einfo is 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 @@ package body Einfo is 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 @@ package body Einfo is 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 @@ package body Einfo is 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"); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 178fc7e3a5c..6779a4b483c 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1706,7 +1706,12 @@ package Einfo is -- 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 @@ package Einfo is -- 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 @@ package Einfo is -- 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 @@ package Einfo is -- 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 @@ package Einfo is -- 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 @@ package Einfo is 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; diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index d80364634b0..ef11b1911f1 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1787,21 +1787,10 @@ package body Exp_Attr is -- 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 diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index e8fb0897fa6..68f504d0ae4 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1605,9 +1605,7 @@ package body Exp_Disp is -- 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 @@ package body Exp_Disp is 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; diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 1edf2bc39ef..16096a412b7 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -843,6 +843,15 @@ package body Exp_Prag is Pname : constant Name_Id := Pragma_Name (N); begin + -- Rewrite pragma ignored by Ignore_Pragma to null statement, so that/ + -- back end or the expander here does not get over-enthusiastic and + -- start processing such a pragma! + + if Get_Name_Table_Boolean3 (Pname) then + Rewrite (N, Make_Null_Statement (Sloc (N))); + return; + end if; + -- Note: we may have a pragma whose Pragma_Identifier field is not a -- recognized pragma, and we must ignore it at this stage. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1bafe663fe1..6a7f052f0a6 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6874,9 +6874,7 @@ package body Exp_Util is 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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index bfee6559088..d43a9fcfc81 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -424,9 +424,7 @@ package body Freeze is 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; diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 2e2e95daa95..4a21ef5b87c 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -135,7 +135,8 @@ package Namet is -- Restriction[_Warning]s pragmas for No_Use_Of_Entity. This avoids most -- unnecessary searches of the No_Use_Of_Entity table. --- The Boolean3 field is not used +-- The Boolean3 field is set for names of pragmas that are to be ignored +-- because of the occurrence of a corresponding pragma Ignore_Pragma. -- In the binder, we have the following uses: diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index 8456177d28f..ec8df4a98b7 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -290,6 +290,12 @@ begin return Pragma_Node; end if; + -- Ignore pragma previously flagged by Ignore_Pragma + + if Get_Name_Table_Boolean3 (Prag_Name) then + return Pragma_Node; + end if; + -- Count number of arguments. This loop also checks if any of the arguments -- are Error, indicating a syntax error as they were parsed. If so, we -- simply return, because we get into trouble with cascaded errors if we @@ -425,6 +431,28 @@ begin Ada_Version := Ada_Version_Explicit; end if; + ------------------- + -- Ignore_Pragma -- + ------------------- + + -- Processing for this pragma must be done at parse time, since we want + -- be able to ignore pragmas that are otherwise processed at parse time. + + when Pragma_Ignore_Pragma => Ignore_Pragma : declare + A : Node_Id; + + begin + Check_Arg_Count (1); + Check_No_Identifier (Arg1); + A := Expression (Arg1); + + if Nkind (A) /= N_Identifier then + Error_Msg ("incorrect argument for pragma %", Sloc (A)); + else + Set_Name_Table_Boolean3 (Chars (A), True); + end if; + end Ignore_Pragma; + ---------------- -- List (2.8) -- ---------------- diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index f149cbaaba5..a6ba49f5da1 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -78,31 +78,11 @@ package body Sem_Aux is 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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 3289f14ef82..4973dc15c80 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5604,6 +5604,11 @@ package body Sem_Ch10 is 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 @@ package body Sem_Ch10 is 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'); - - 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 (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; + CW_Typ := + New_External_Entity + (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); + + 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 (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; end Decorate_Type; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 6fb250c9461..0af8a4624af 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4116,26 +4116,14 @@ package body Sem_Ch4 is -- 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 @@ package body Sem_Ch4 is 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; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 5bac8b26f87..1c85f914363 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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 @@ package body Sem_Ch5 is -- 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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 2f9e1f5532b..eb09ee3b597 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2923,9 +2923,8 @@ package body Sem_Ch6 is 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; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 921b781ea20..2a74e6f08c3 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5767,18 +5767,20 @@ package body Sem_Ch8 is 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 @@ package body Sem_Ch8 is -- 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; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index bc36c27cb4b..26b3df25289 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -336,7 +336,7 @@ package body Sem_Disp is -- 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4fe9007aacb..f3f10cd1917 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9373,6 +9373,12 @@ package body Sem_Prag is return; end if; + -- Ignore pragma if Ignore_Pragma applies + + if Get_Name_Table_Boolean3 (Pname) then + return; + end if; + -- Here to start processing for recognized pragma Prag_Id := Get_Pragma_Id (Pname); @@ -14239,6 +14245,17 @@ package body Sem_Prag is end; end Ident; + ------------------- + -- Ignore_Pragma -- + ------------------- + + -- pragma Ignore_Pragma (pragma_IDENTIFIER); + + -- Entirely handled in the parser, nothing to do here + + when Pragma_Ignore_Pragma => + null; + ---------------------------- -- Implementation_Defined -- ---------------------------- @@ -25690,6 +25707,7 @@ package body Sem_Prag is Pragma_Ghost => 0, Pragma_Global => -1, Pragma_Ident => -1, + Pragma_Ignore_Pragma => 0, Pragma_Implementation_Defined => -1, Pragma_Implemented => -1, Pragma_Implicit_Packing => 0, diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 69cd3396de7..b838e25b4cb 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -10744,19 +10744,11 @@ package body Sem_Res is -- 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 @@ package body Sem_Res is 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 diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index d9f4e53aa61..b4d752d3258 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1227,15 +1227,8 @@ package body Sem_Type is -- 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); - - elsif Ekind (T1) = E_Class_Wide_Type then - return - Covers (Class_Wide_Type (Non_Limited_View (Etype (T1))), T2); - else - return False; - end if; + return Has_Non_Limited_View (T1) + and then Covers (Get_Full_View (Non_Limited_View (T1)), T2); elsif From_Limited_With (T2) then @@ -1243,17 +1236,8 @@ package body Sem_Type is -- 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))); - - 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; + return Has_Non_Limited_View (T2) + and then Covers (T1, Get_Full_View (Non_Limited_View (T2))); -- Ada 2005 (AI-412): Coverage for regular incomplete subtypes diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 94e1d6248fe..f6b76e11a7f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -4941,7 +4941,7 @@ package body Sem_Util is -- 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)) diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index cd9d7f118b6..534d0d09d3b 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -401,6 +401,7 @@ package Snames is -- Fast_Math. Name_Favor_Top_Level : constant Name_Id := N + $; -- GNAT + Name_Ignore_Pragma : constant Name_Id := N + $; -- GNAT Name_Implicit_Packing : constant Name_Id := N + $; -- GNAT Name_Initialize_Scalars : constant Name_Id := N + $; -- GNAT Name_Interrupt_State : constant Name_Id := N + $; -- GNAT @@ -1749,6 +1750,7 @@ package Snames is Pragma_Extensions_Allowed, Pragma_External_Name_Casing, Pragma_Favor_Top_Level, + Pragma_Ignore_Pragma, Pragma_Implicit_Packing, Pragma_Initialize_Scalars, Pragma_Interrupt_State,