OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

einfo.ads, einfo.adb (Suppress_Initialization): Replaces Suppress_Init_Procs. 

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* einfo.ads, einfo.adb (Suppress_Initialization): Replaces
	Suppress_Init_Procs.
	* exp_ch3.adb, exp_disp.adb, freeze.adb: Use
	Suppress_Initialization/Initialization_Suppressed.
	* gnat_rm.texi: New documentation for pragma Suppress_Initialization
	* sem_aux.ads, sem_aux.adb (Initialization_Suppressed): New function
	* sem_dist.adb: Use Suppress_Initialization/Initialization_Suppressed
	* sem_prag.adb: New processing for pragma Suppress_Initialization.

From-SVN: r177161
This commit is contained in:
Robert Dewar 2011-08-02 14:35:51 +00:00 committed by Arnaud Charlet
parent 5ad4969daf
commit 5b1e6aca6a
11 changed files with 101 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2011-08-02 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Suppress_Initialization): Replaces
Suppress_Init_Procs.
* exp_ch3.adb, exp_disp.adb, freeze.adb: Use
Suppress_Initialization/Initialization_Suppressed.
* gnat_rm.texi: New documentation for pragma Suppress_Initialization
* sem_aux.ads, sem_aux.adb (Initialization_Suppressed): New function
* sem_dist.adb: Use Suppress_Initialization/Initialization_Suppressed
* sem_prag.adb: New processing for pragma Suppress_Initialization.
2011-08-02 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi, a-tags.ads, sem_prag.adb, sem_ch12.adb, exp_disp.adb:

17
gcc/ada/einfo.adb
View File

@ -357,7 +357,7 @@ package body Einfo is
-- Is_Called Flag102
-- Is_Completely_Hidden Flag103
-- Address_Taken Flag104
-- Suppress_Init_Proc Flag105
-- Suppress_Initialization Flag105
-- Is_Limited_Composite Flag106
-- Is_Private_Composite Flag107
-- Default_Expressions_Processed Flag108
@ -2686,10 +2686,11 @@ package body Einfo is
return Flag148 (Id);
end Suppress_Elaboration_Warnings;
function Suppress_Init_Proc (Id : E) return B is
function Suppress_Initialization (Id : E) return B is
begin
return Flag105 (Base_Type (Id));
end Suppress_Init_Proc;
pragma Assert (Is_Type (Id));
return Flag105 (Id);
end Suppress_Initialization;
function Suppress_Style_Checks (Id : E) return B is
begin
@ -5204,11 +5205,11 @@ package body Einfo is
Set_Flag148 (Id, V);
end Set_Suppress_Elaboration_Warnings;
procedure Set_Suppress_Init_Proc (Id : E; V : B := True) is
procedure Set_Suppress_Initialization (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
pragma Assert (Is_Type (Id));
Set_Flag105 (Id, V);
end Set_Suppress_Init_Proc;
end Set_Suppress_Initialization;
procedure Set_Suppress_Style_Checks (Id : E; V : B := True) is
begin
@ -7567,7 +7568,7 @@ package body Einfo is
W ("Static_Elaboration_Desired", Flag77 (Id));
W ("Strict_Alignment", Flag145 (Id));
W ("Suppress_Elaboration_Warnings", Flag148 (Id));
W ("Suppress_Init_Proc", Flag105 (Id));
W ("Suppress_Initialization", Flag105 (Id));
W ("Suppress_Style_Checks", Flag165 (Id));
W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
W ("Treat_As_Volatile", Flag41 (Id));

23
gcc/ada/einfo.ads
View File

@ -3709,10 +3709,15 @@ package Einfo is
-- elaboration, and it is set on variables when a warning is given to
-- avoid multiple elaboration warnings for the same variable.
-- Suppress_Init_Proc (Flag105) [base type only]
-- Present in all type entities. Set to suppress the generation of
-- initialization procedures where they are known to be not needed.
-- For example, the enumeration image table entity uses this flag.
-- Suppress_Initialization (Flag105)
-- Present in all type and subtype entities. If set for the base type,
-- then the generation of initialization procedures is suppressed for the
-- type. Any other implicit initialiation (e.g. from the use of pragma
-- Initialize_Scalars) is also suppressed if this flag is set either for
-- the subtype in question, or for the base type. Set by use of pragma
-- Suppress_Initialization and also for internal entities where we know
-- that no initialization is required. For example, enumeration image
-- table entities set it.
-- Suppress_Style_Checks (Flag165)
-- Present in all entities. Suppresses any style checks specifically
@ -4849,7 +4854,7 @@ package Einfo is
-- Size_Depends_On_Discriminant (Flag177)
-- Size_Known_At_Compile_Time (Flag92)
-- Strict_Alignment (Flag145) (base type only)
-- Suppress_Init_Proc (Flag105) (base type only)
-- Suppress_Initialization (Flag105)
-- Treat_As_Volatile (Flag41)
-- Universal_Aliasing (Flag216) (base type only)
@ -6280,7 +6285,7 @@ package Einfo is
function String_Literal_Low_Bound (Id : E) return N;
function Subprograms_For_Type (Id : E) return E;
function Suppress_Elaboration_Warnings (Id : E) return B;
function Suppress_Init_Proc (Id : E) return B;
function Suppress_Initialization (Id : E) return B;
function Suppress_Style_Checks (Id : E) return B;
function Suppress_Value_Tracking_On_Call (Id : E) return B;
function Task_Body_Procedure (Id : E) return N;
@ -6869,7 +6874,7 @@ package Einfo is
procedure Set_String_Literal_Low_Bound (Id : E; V : N);
procedure Set_Subprograms_For_Type (Id : E; V : E);
procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True);
procedure Set_Suppress_Init_Proc (Id : E; V : B := True);
procedure Set_Suppress_Initialization (Id : E; V : B := True);
procedure Set_Suppress_Style_Checks (Id : E; V : B := True);
procedure Set_Suppress_Value_Tracking_On_Call (Id : E; V : B := True);
procedure Set_Task_Body_Procedure (Id : E; V : N);
@ -7603,7 +7608,7 @@ package Einfo is
pragma Inline (String_Literal_Low_Bound);
pragma Inline (Subprograms_For_Type);
pragma Inline (Suppress_Elaboration_Warnings);
pragma Inline (Suppress_Init_Proc);
pragma Inline (Suppress_Initialization);
pragma Inline (Suppress_Style_Checks);
pragma Inline (Suppress_Value_Tracking_On_Call);
pragma Inline (Task_Body_Procedure);
@ -7998,7 +8003,7 @@ package Einfo is
pragma Inline (Set_String_Literal_Low_Bound);
pragma Inline (Set_Subprograms_For_Type);
pragma Inline (Set_Suppress_Elaboration_Warnings);
pragma Inline (Set_Suppress_Init_Proc);
pragma Inline (Set_Suppress_Initialization);
pragma Inline (Set_Suppress_Style_Checks);
pragma Inline (Set_Suppress_Value_Tracking_On_Call);
pragma Inline (Set_Task_Body_Procedure);

17
gcc/ada/exp_ch3.adb
View File

@ -674,7 +674,7 @@ package body Exp_Ch3 is
-- 3. The type has CIL/JVM convention.
-- 4. An initialization already exists for the base type
if Suppress_Init_Proc (A_Type)
if Initialization_Suppressed (A_Type)
or else Is_Value_Type (Comp_Type)
or else Convention (A_Type) = Convention_CIL
or else Convention (A_Type) = Convention_Java
@ -3216,7 +3216,7 @@ package body Exp_Ch3 is
begin
-- Definitely do not need one if specifically suppressed
if Suppress_Init_Proc (Rec_Id) then
if Initialization_Suppressed (Rec_Id) then
return False;
end if;
@ -4682,12 +4682,9 @@ package body Exp_Ch3 is
and then not Is_Value_Type (Typ)
-- Suppress call if Suppress_Init_Proc set on the type. This is
-- needed for the derived type case, where Suppress_Initialization
-- may be set for the derived type, even if there is an init proc
-- defined for the root type.
-- Suppress call if initialization suppressed for the type
and then not Suppress_Init_Proc (Typ)
and then not Initialization_Suppressed (Typ)
then
-- Return without initializing when No_Default_Initialization
-- applies. Note that the actual restriction check occurs later,
@ -8536,6 +8533,12 @@ package body Exp_Ch3 is
or (Initialize_Scalars and Consider_IS);
begin
-- Never need initialization if it is suppressed
if Initialization_Suppressed (T) then
return False;
end if;
-- Check for private type, in which case test applies to the underlying
-- type of the private type.

2
gcc/ada/exp_disp.adb
View File

@ -6728,7 +6728,7 @@ package body Exp_Disp is
-- to simplify the expansion associated with dispatching calls.
Analyze_List (Result);
Set_Suppress_Init_Proc (Base_Type (DT_Prims));
Set_Suppress_Initialization (Base_Type (DT_Prims));
-- Disable backend optimizations based on assumptions about the
-- aliasing status of objects designated by the access to the

2
gcc/ada/freeze.adb
View File

@ -2865,7 +2865,7 @@ package body Freeze is
((Has_Non_Null_Base_Init_Proc (Etype (E))
and then not No_Initialization (Declaration_Node (E))
and then not Is_Value_Type (Etype (E))
and then not Suppress_Init_Proc (Etype (E)))
and then not Initialization_Suppressed (Etype (E)))
or else
(Needs_Simple_Initialization (Etype (E))
and then not Is_Internal (E)))

13
gcc/ada/gnat_rm.texi
View File

@ -4892,7 +4892,18 @@ pragma Suppress_Initialization ([Entity =>] type_Name);
@noindent
This pragma suppresses any implicit or explicit initialization
associated with the given type name for all variables of this type.
associated with the given type name for all variables of this type,
including initialization resulting from the use of pragmas
Normalize_Scalars or Initialize_Scalars.
This is considered a representation item, so it cannot be given after
the type is frozen. It applies to all subsequent object declarations,
and also any allocator that creates objects of the type.
If the pragma is given for the first subtype, then it is considered
to apply to the base type and all its subtypes. If the pragma is given
for other than a first subtype, then it applies only to the given subtype.
The pragma may not be given after the type is frozen.
@node Pragma Task_Info
@unnumberedsec Pragma Task_Info

10
gcc/ada/sem_aux.adb
View File

@ -403,6 +403,16 @@ package body Sem_Aux is
return Empty;
end First_Tag_Component;
-------------------------------
-- Initialization_Suppressed --
-------------------------------
function Initialization_Suppressed (Typ : Entity_Id) return Boolean is
begin
return Suppress_Initialization (Typ)
or else Suppress_Initialization (Base_Type (Typ));
end Initialization_Suppressed;
----------------
-- Initialize --
----------------

6
gcc/ada/sem_aux.ads
View File

@ -217,6 +217,12 @@ package Sem_Aux is
function Number_Discriminants (Typ : Entity_Id) return Pos;
-- Typ is a type with discriminants, yields number of discriminants in type
function Initialization_Suppressed (Typ : Entity_Id) return Boolean;
pragma Inline (Initialization_Suppressed);
-- Returns True if initialization should be suppressed for the given type
-- or subtype. This is true if Suppress_Initialization is set either for
-- the subtype itself, or for the corresponding base type.
function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
pragma Inline (Ultimate_Alias);
-- Return the last entity in the chain of aliased entities of Prim. If Prim

2
gcc/ada/sem_dist.adb
View File

@ -610,7 +610,7 @@ package body Sem_Dist is
-- is active), and there are order of elaboration problems if we do try
-- to generate an init proc for this created record type.
Set_Suppress_Init_Proc (Fat_Type);
Set_Suppress_Initialization (Fat_Type);
if Expander_Active then
Add_RAST_Features (Parent (User_Type));

39
gcc/ada/sem_prag.adb
View File

@ -6359,7 +6359,6 @@ package body Sem_Prag is
("pragma% cannot be applied to function", Arg1);
elsif Is_Remote_Access_To_Subprogram_Type (Nm) then
if Is_Record_Type (Nm) then
-- A record type that is the Equivalent_Type for a remote
@ -12751,22 +12750,36 @@ package body Sem_Prag is
E := Entity (E_Id);
if Is_Type (E) then
if Is_Incomplete_Or_Private_Type (E) then
if No (Full_View (Base_Type (E))) then
Error_Pragma_Arg
("argument of pragma% cannot be an incomplete type",
Arg1);
else
Set_Suppress_Init_Proc (Full_View (Base_Type (E)));
end if;
if not Is_Type (E) then
Error_Pragma_Arg ("pragma% requires type or subtype", Arg1);
end if;
if Rep_Item_Too_Early (E, N)
or else
Rep_Item_Too_Late (E, N, FOnly => True)
then
return;
end if;
-- For incomplete/private type, set flag on full view
if Is_Incomplete_Or_Private_Type (E) then
if No (Full_View (Base_Type (E))) then
Error_Pragma_Arg
("argument of pragma% cannot be an incomplete type", Arg1);
else
Set_Suppress_Init_Proc (Base_Type (E));
Set_Suppress_Initialization (Full_View (Base_Type (E)));
end if;
-- For first subtype, set flag on base type
elsif Is_First_Subtype (E) then
Set_Suppress_Initialization (Base_Type (E));
-- For other than first subtype, set flag on subtype itself
else
Error_Pragma_Arg
("pragma% requires argument that is a type name", Arg1);
Set_Suppress_Initialization (E);
end if;
end Suppress_Init;