summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2015-05-12 08:11:25 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2015-05-12 08:11:25 +0000
commit40993cdbd6bce99216628aa4e4273ad0e5265f25 (patch)
tree437c2d0856bbb6a4ed19c76af7be237db1cd11ab
parentc89d7e9cc4d38244b0e8456704812486ece650fc (diff)
downloadgcc-40993cdbd6bce99216628aa4e4273ad0e5265f25.tar.gz
2015-05-12 Robert Dewar <dewar@adacore.com>
* 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 <miranda@adacore.com> * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@223038 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/ChangeLog35
-rw-r--r--gcc/ada/einfo.adb35
-rw-r--r--gcc/ada/einfo.ads18
-rw-r--r--gcc/ada/exp_attr.adb15
-rw-r--r--gcc/ada/exp_disp.adb25
-rw-r--r--gcc/ada/exp_prag.adb9
-rw-r--r--gcc/ada/exp_util.adb4
-rw-r--r--gcc/ada/freeze.adb4
-rw-r--r--gcc/ada/namet.ads3
-rw-r--r--gcc/ada/par-prag.adb28
-rw-r--r--gcc/ada/sem_aux.adb24
-rw-r--r--gcc/ada/sem_ch10.adb61
-rw-r--r--gcc/ada/sem_ch4.adb17
-rw-r--r--gcc/ada/sem_ch5.adb5
-rw-r--r--gcc/ada/sem_ch6.adb5
-rw-r--r--gcc/ada/sem_ch8.adb24
-rw-r--r--gcc/ada/sem_disp.adb2
-rw-r--r--gcc/ada/sem_prag.adb18
-rw-r--r--gcc/ada/sem_res.adb23
-rw-r--r--gcc/ada/sem_type.adb24
-rw-r--r--gcc/ada/sem_util.adb2
-rw-r--r--gcc/ada/snames.ads-tmpl2
22 files changed, 205 insertions, 178 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e2666c62709..5de8f002659 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,40 @@
2015-05-12 Robert Dewar <dewar@adacore.com>
+ * 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 <miranda@adacore.com>
+
+ * 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 <dewar@adacore.com>
+
* exp_unst.adb (Get_Real_Subp): New subprogram.
(Unnest_Subprogram): Use Get_Real_Subp.
(Uplev_Refs_For_One_Subp): Skip if no ARECnU entity.
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,