+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:
-- 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
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
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
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));
-- 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
-- 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)
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;
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);
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);
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);
-- 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
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;
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,
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.
-- 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
((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)))
@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
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 --
----------------
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
-- 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));
("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
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;
projects / gcc.git / commitdiff