Commit ff9d220e by Eric Botcazou Committed by Pierre-Marie de Rodat

[Ada] Remove obsolete Is_For_Access_Subtype machinery

This change removes the Is_For_Access_Subtype machinery from the
compiler.  This machinery was devised a long time ago to deal with a
peculiarity of the freezing for access-to-record subtypes but has been
degenerate for quite some time now and does not seem to serve any useful
purpose at this point.

Morever it has an annoying side effect whereby it causes Underlying_Type
to return the (unconstrained) base record type when invoked on the
designated record subtype, which is very problematic for GNATprove.

There should be no functional changes.

2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* einfo.ads (Is_For_Access_Subtype): Delete.
	(Set_Is_For_Access_Subtype): Likewise.
	* einfo.adb (Is_For_Access_Subtype): Likewise.
	(Set_Is_For_Access_Subtype): Likewise.
	(Write_Entity_Flags): Do not write Is_For_Access_Subtype.
	* exp_ch4.adb (Expand_N_Selected_Component): Do not deal with
	it.
	* exp_spark.adb (Expand_SPARK_N_Selected_Component): Likewise.
	* sem_ch4.adb (Analyze_Explicit_Dereference): Likewise.
	* sem_ch3.adb (Build_Discriminated_Subtype): Do not build a
	special private subtype for access-to-record subtypes.

From-SVN: r273682
parent 78e92e11
2019-07-22 Eric Botcazou <ebotcazou@adacore.com> 2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
* einfo.ads (Is_For_Access_Subtype): Delete.
(Set_Is_For_Access_Subtype): Likewise.
* einfo.adb (Is_For_Access_Subtype): Likewise.
(Set_Is_For_Access_Subtype): Likewise.
(Write_Entity_Flags): Do not write Is_For_Access_Subtype.
* exp_ch4.adb (Expand_N_Selected_Component): Do not deal with
it.
* exp_spark.adb (Expand_SPARK_N_Selected_Component): Likewise.
* sem_ch4.adb (Analyze_Explicit_Dereference): Likewise.
* sem_ch3.adb (Build_Discriminated_Subtype): Do not build a
special private subtype for access-to-record subtypes.
2019-07-22 Eric Botcazou <ebotcazou@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): Rework the setting of * sem_ch3.adb (Complete_Private_Subtype): Rework the setting of
the Etype of the full view for full base types that cannot the Etype of the full view for full base types that cannot
contain any discriminant. Remove code and comment about it in contain any discriminant. Remove code and comment about it in
......
...@@ -421,7 +421,6 @@ package body Einfo is ...@@ -421,7 +421,6 @@ package body Einfo is
-- Never_Set_In_Source Flag115 -- Never_Set_In_Source Flag115
-- Is_Visible_Lib_Unit Flag116 -- Is_Visible_Lib_Unit Flag116
-- Is_Unchecked_Union Flag117 -- Is_Unchecked_Union Flag117
-- Is_For_Access_Subtype Flag118
-- Has_Convention_Pragma Flag119 -- Has_Convention_Pragma Flag119
-- Has_Primitive_Operations Flag120 -- Has_Primitive_Operations Flag120
...@@ -2303,12 +2302,6 @@ package body Einfo is ...@@ -2303,12 +2302,6 @@ package body Einfo is
return Flag70 (Id); return Flag70 (Id);
end Is_First_Subtype; end Is_First_Subtype;
function Is_For_Access_Subtype (Id : E) return B is
begin
pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
return Flag118 (Id);
end Is_For_Access_Subtype;
function Is_Formal_Subprogram (Id : E) return B is function Is_Formal_Subprogram (Id : E) return B is
begin begin
return Flag111 (Id); return Flag111 (Id);
...@@ -5526,12 +5519,6 @@ package body Einfo is ...@@ -5526,12 +5519,6 @@ package body Einfo is
Set_Flag70 (Id, V); Set_Flag70 (Id, V);
end Set_Is_First_Subtype; end Set_Is_First_Subtype;
procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
begin
pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
Set_Flag118 (Id, V);
end Set_Is_For_Access_Subtype;
procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
begin begin
Set_Flag111 (Id, V); Set_Flag111 (Id, V);
...@@ -9826,7 +9813,6 @@ package body Einfo is ...@@ -9826,7 +9813,6 @@ package body Einfo is
W ("Is_Exported", Flag99 (Id)); W ("Is_Exported", Flag99 (Id));
W ("Is_Finalized_Transient", Flag252 (Id)); W ("Is_Finalized_Transient", Flag252 (Id));
W ("Is_First_Subtype", Flag70 (Id)); W ("Is_First_Subtype", Flag70 (Id));
W ("Is_For_Access_Subtype", Flag118 (Id));
W ("Is_Formal_Subprogram", Flag111 (Id)); W ("Is_Formal_Subprogram", Flag111 (Id));
W ("Is_Frozen", Flag4 (Id)); W ("Is_Frozen", Flag4 (Id));
W ("Is_Generic_Actual_Subprogram", Flag274 (Id)); W ("Is_Generic_Actual_Subprogram", Flag274 (Id));
......
...@@ -2608,12 +2608,6 @@ package Einfo is ...@@ -2608,12 +2608,6 @@ package Einfo is
-- Is_Formal_Subprogram (Flag111) -- Is_Formal_Subprogram (Flag111)
-- Defined in all entities. Set for generic formal subprograms. -- Defined in all entities. Set for generic formal subprograms.
-- Is_For_Access_Subtype (Flag118)
-- Defined in E_Private_Subtype and E_Record_Subtype entities. Means the
-- sole purpose of the type is to be designated by an Access_Subtype and
-- hence should not be expanded into components because the type may not
-- have been found or frozen yet.
-- Is_Frozen (Flag4) -- Is_Frozen (Flag4)
-- Defined in all type and subtype entities. Set if type or subtype has -- Defined in all type and subtype entities. Set if type or subtype has
-- been frozen. -- been frozen.
...@@ -6458,7 +6452,6 @@ package Einfo is ...@@ -6458,7 +6452,6 @@ package Einfo is
-- Stored_Constraint (Elist23) -- Stored_Constraint (Elist23)
-- Has_Completion (Flag26) -- Has_Completion (Flag26)
-- Is_Controlled_Active (Flag42) (base type only) -- Is_Controlled_Active (Flag42) (base type only)
-- Is_For_Access_Subtype (Flag118) (subtype only)
-- (plus type attributes) -- (plus type attributes)
-- E_Procedure -- E_Procedure
...@@ -7311,7 +7304,6 @@ package Einfo is ...@@ -7311,7 +7304,6 @@ package Einfo is
function Is_Exported (Id : E) return B; function Is_Exported (Id : E) return B;
function Is_Finalized_Transient (Id : E) return B; function Is_Finalized_Transient (Id : E) return B;
function Is_First_Subtype (Id : E) return B; function Is_First_Subtype (Id : E) return B;
function Is_For_Access_Subtype (Id : E) return B;
function Is_Frozen (Id : E) return B; function Is_Frozen (Id : E) return B;
function Is_Generic_Instance (Id : E) return B; function Is_Generic_Instance (Id : E) return B;
function Is_Hidden (Id : E) return B; function Is_Hidden (Id : E) return B;
...@@ -8012,7 +8004,6 @@ package Einfo is ...@@ -8012,7 +8004,6 @@ package Einfo is
procedure Set_Is_Exported (Id : E; V : B := True); procedure Set_Is_Exported (Id : E; V : B := True);
procedure Set_Is_Finalized_Transient (Id : E; V : B := True); procedure Set_Is_Finalized_Transient (Id : E; V : B := True);
procedure Set_Is_First_Subtype (Id : E; V : B := True); procedure Set_Is_First_Subtype (Id : E; V : B := True);
procedure Set_Is_For_Access_Subtype (Id : E; V : B := True);
procedure Set_Is_Formal_Subprogram (Id : E; V : B := True); procedure Set_Is_Formal_Subprogram (Id : E; V : B := True);
procedure Set_Is_Frozen (Id : E; V : B := True); procedure Set_Is_Frozen (Id : E; V : B := True);
procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True); procedure Set_Is_Generic_Actual_Subprogram (Id : E; V : B := True);
...@@ -8859,7 +8850,6 @@ package Einfo is ...@@ -8859,7 +8850,6 @@ package Einfo is
pragma Inline (Is_First_Subtype); pragma Inline (Is_First_Subtype);
pragma Inline (Is_Fixed_Point_Type); pragma Inline (Is_Fixed_Point_Type);
pragma Inline (Is_Floating_Point_Type); pragma Inline (Is_Floating_Point_Type);
pragma Inline (Is_For_Access_Subtype);
pragma Inline (Is_Formal); pragma Inline (Is_Formal);
pragma Inline (Is_Formal_Object); pragma Inline (Is_Formal_Object);
pragma Inline (Is_Formal_Subprogram); pragma Inline (Is_Formal_Subprogram);
...@@ -9376,7 +9366,6 @@ package Einfo is ...@@ -9376,7 +9366,6 @@ package Einfo is
pragma Inline (Set_Is_Exported); pragma Inline (Set_Is_Exported);
pragma Inline (Set_Is_Finalized_Transient); pragma Inline (Set_Is_Finalized_Transient);
pragma Inline (Set_Is_First_Subtype); pragma Inline (Set_Is_First_Subtype);
pragma Inline (Set_Is_For_Access_Subtype);
pragma Inline (Set_Is_Formal_Subprogram); pragma Inline (Set_Is_Formal_Subprogram);
pragma Inline (Set_Is_Frozen); pragma Inline (Set_Is_Frozen);
pragma Inline (Set_Is_Generic_Actual_Subprogram); pragma Inline (Set_Is_Generic_Actual_Subprogram);
......
...@@ -10330,12 +10330,6 @@ package body Exp_Ch4 is ...@@ -10330,12 +10330,6 @@ package body Exp_Ch4 is
Insert_Explicit_Dereference (P); Insert_Explicit_Dereference (P);
Analyze_And_Resolve (P, Designated_Type (Ptyp)); Analyze_And_Resolve (P, Designated_Type (Ptyp));
if Ekind (Etype (P)) = E_Private_Subtype
and then Is_For_Access_Subtype (Etype (P))
then
Set_Etype (P, Base_Type (Etype (P)));
end if;
Ptyp := Etype (P); Ptyp := Etype (P);
end if; end if;
......
...@@ -522,12 +522,6 @@ package body Exp_SPARK is ...@@ -522,12 +522,6 @@ package body Exp_SPARK is
Insert_Explicit_Dereference (Pref); Insert_Explicit_Dereference (Pref);
Analyze_And_Resolve (Pref, Designated_Type (Typ)); Analyze_And_Resolve (Pref, Designated_Type (Typ));
if Ekind (Etype (Pref)) = E_Private_Subtype
and then Is_For_Access_Subtype (Etype (Pref))
then
Set_Etype (Pref, Base_Type (Etype (Pref)));
end if;
end if; end if;
end Expand_SPARK_N_Selected_Component; end Expand_SPARK_N_Selected_Component;
......
...@@ -221,9 +221,7 @@ package body Sem_Ch3 is ...@@ -221,9 +221,7 @@ package body Sem_Ch3 is
-- T has discriminants but there are no discriminant constraints). The -- T has discriminants but there are no discriminant constraints). The
-- Related_Nod is the same as Decl_Node in Create_Constrained_Components. -- Related_Nod is the same as Decl_Node in Create_Constrained_Components.
-- The For_Access says whether or not this subtype is really constraining -- The For_Access says whether or not this subtype is really constraining
-- an access type. That is its sole purpose is the designated type of an -- an access type.
-- access type -- in which case a Private_Subtype Is_For_Access_Subtype
-- is built to avoid freezing T when the access subtype is frozen.
function Build_Scalar_Bound function Build_Scalar_Bound
(Bound : Node_Id; (Bound : Node_Id;
...@@ -10236,12 +10234,7 @@ package body Sem_Ch3 is ...@@ -10236,12 +10234,7 @@ package body Sem_Ch3 is
begin begin
if Ekind (T) = E_Record_Type then if Ekind (T) = E_Record_Type then
if For_Access then Set_Ekind (Def_Id, E_Record_Subtype);
Set_Ekind (Def_Id, E_Private_Subtype);
Set_Is_For_Access_Subtype (Def_Id, True);
else
Set_Ekind (Def_Id, E_Record_Subtype);
end if;
-- Inherit preelaboration flag from base, for types for which it -- Inherit preelaboration flag from base, for types for which it
-- may have been set: records, private types, protected types. -- may have been set: records, private types, protected types.
...@@ -10372,7 +10365,7 @@ package body Sem_Ch3 is ...@@ -10372,7 +10365,7 @@ package body Sem_Ch3 is
then then
Create_Constrained_Components (Def_Id, Related_Nod, T, Elist); Create_Constrained_Components (Def_Id, Related_Nod, T, Elist);
elsif not For_Access then else
Set_Cloned_Subtype (Def_Id, T); Set_Cloned_Subtype (Def_Id, T);
end if; end if;
end if; end if;
......
...@@ -2101,21 +2101,12 @@ package body Sem_Ch4 is ...@@ -2101,21 +2101,12 @@ package body Sem_Ch4 is
if not Is_Overloaded (P) then if not Is_Overloaded (P) then
if Is_Access_Type (Etype (P)) then if Is_Access_Type (Etype (P)) then
-- Set the Etype. We need to go through Is_For_Access_Subtypes to -- Set the Etype
-- avoid other problems caused by the Private_Subtype and it is
-- safe to go to the Base_Type because this is the same as
-- converting the access value to its Base_Type.
declare declare
DT : Entity_Id := Designated_Type (Etype (P)); DT : constant Entity_Id := Designated_Type (Etype (P));
begin begin
if Ekind (DT) = E_Private_Subtype
and then Is_For_Access_Subtype (DT)
then
DT := Base_Type (DT);
end if;
-- An explicit dereference is a legal occurrence of an -- An explicit dereference is a legal occurrence of an
-- incomplete type imported through a limited_with clause, if -- incomplete type imported through a limited_with clause, if
-- the full view is visible, or if we are within an instance -- the full view is visible, or if we are within an instance
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment