[Ada] Initialize_Scalars should not clobber variable with address clause
Arnaud Charlet
charlet@adacore.com
Mon Jun 14 10:17:00 GMT 2010
This patch prevents Initialize_Scalars from initializing scalars with
address clauses, and thus suppresses the annoying warning associated
with this initialization. The following should compile quietly (it used
to give a warning about needing pragma Import).
pragma Initialize_Scalars;
with System; use System;
procedure IS_Overlay (A : Address) is
X : Integer;
for X'Address use A;
begin
null;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2010-06-14 Robert Dewar <dewar@adacore.com>
* exp_aggr.adb (Has_Address_Clause): Moved to Exp_Util, and there it
is renamed as Has_Following_Address_Clause.
* exp_ch3.adb (Needs_Simple_Initialization): Add Consider_IS argument
to allow the caller to avoid Initialize_Scalars having an effect.
(Expand_N_Object_Declaration): Do not do Initialize_Scalars stuff for
scalars with an address clause specified.
* exp_ch3.ads (Needs_Simple_Initialization): Add Consider_IS argument
to allow the caller to avoid Initialize_Scalars having an effect.
* exp_util.adb (Has_Following_Address_Clause): Moved here from Exp_Aggr
(where it was called Has_Address_Clause).
* exp_util.ads (Has_Following_Address_Clause): Moved here from Exp_Aggr
(where it was called Has_Address_Clause).
* freeze.adb (Warn_Overlay): Suppress message about overlaying causing
problems for Initialize_Scalars (since we no longer initialize objects
with an address clause.
-------------- next part --------------
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 160705)
+++ exp_util.adb (working copy)
@@ -2143,6 +2143,37 @@
return False;
end Has_Controlled_Coextensions;
+ ------------------------
+ -- Has_Address_Clause --
+ ------------------------
+
+ -- Should this function check the private part in a package ???
+
+ function Has_Following_Address_Clause (D : Node_Id) return Boolean is
+ Id : constant Entity_Id := Defining_Identifier (D);
+ Decl : Node_Id;
+
+ begin
+ Decl := Next (D);
+ while Present (Decl) loop
+ if Nkind (Decl) = N_At_Clause
+ and then Chars (Identifier (Decl)) = Chars (Id)
+ then
+ return True;
+
+ elsif Nkind (Decl) = N_Attribute_Definition_Clause
+ and then Chars (Decl) = Name_Address
+ and then Chars (Name (Decl)) = Chars (Id)
+ then
+ return True;
+ end if;
+
+ Next (Decl);
+ end loop;
+
+ return False;
+ end Has_Following_Address_Clause;
+
--------------------
-- Homonym_Number --
--------------------
Index: exp_util.ads
===================================================================
--- exp_util.ads (revision 160705)
+++ exp_util.ads (working copy)
@@ -444,6 +444,11 @@
-- Determine whether a record type has anonymous access discriminants with
-- a controlled designated type.
+ function Has_Following_Address_Clause (D : Node_Id) return Boolean;
+ -- D is the node for an object declaration. This function searches the
+ -- current declarative part to look for an address clause for the object
+ -- being declared, and returns True if one is found.
+
function Homonym_Number (Subp : Entity_Id) return Nat;
-- Here subp is the entity for a subprogram. This routine returns the
-- homonym number used to disambiguate overloaded subprograms in the same
Index: freeze.adb
===================================================================
--- freeze.adb (revision 160705)
+++ freeze.adb (working copy)
@@ -5659,16 +5659,18 @@
-- We only give the warning for non-imported entities of a type for
-- which a non-null base init proc is defined, or for objects of access
- -- types with implicit null initialization, or when Initialize_Scalars
+ -- types with implicit null initialization, or when Normalize_Scalars
-- applies and the type is scalar or a string type (the latter being
-- tested for because predefined String types are initialized by inline
- -- code rather than by an init_proc).
+ -- code rather than by an init_proc). Note that we do not give the
+ -- warning for Initialize_Scalars, since we suppressed initialization
+ -- in this case.
if Present (Expr)
and then not Is_Imported (Ent)
and then (Has_Non_Null_Base_Init_Proc (Typ)
or else Is_Access_Type (Typ)
- or else (Init_Or_Norm_Scalars
+ or else (Normalize_Scalars
and then (Is_Scalar_Type (Typ)
or else Is_String_Type (Typ))))
then
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 160705)
+++ exp_aggr.adb (working copy)
@@ -4122,12 +4122,6 @@
-- array sub-aggregate we start the computation from. Dim is the
-- dimension corresponding to the sub-aggregate.
- function Has_Address_Clause (D : Node_Id) return Boolean;
- -- If the aggregate is the expression in an object declaration, it
- -- cannot be expanded in place. This function does a lookahead in the
- -- current declarative part to find an address clause for the object
- -- being declared.
-
function In_Place_Assign_OK return Boolean;
-- Simple predicate to determine whether an aggregate assignment can
-- be done in place, because none of the new values can depend on the
@@ -4435,35 +4429,6 @@
end Compute_Others_Present;
------------------------
- -- Has_Address_Clause --
- ------------------------
-
- function Has_Address_Clause (D : Node_Id) return Boolean is
- Id : constant Entity_Id := Defining_Identifier (D);
- Decl : Node_Id;
-
- begin
- Decl := Next (D);
- while Present (Decl) loop
- if Nkind (Decl) = N_At_Clause
- and then Chars (Identifier (Decl)) = Chars (Id)
- then
- return True;
-
- elsif Nkind (Decl) = N_Attribute_Definition_Clause
- and then Chars (Decl) = Name_Address
- and then Chars (Name (Decl)) = Chars (Id)
- then
- return True;
- end if;
-
- Next (Decl);
- end loop;
-
- return False;
- end Has_Address_Clause;
-
- ------------------------
-- In_Place_Assign_OK --
------------------------
@@ -5162,6 +5127,8 @@
Build_Activation_Chain_Entity (N);
end if;
+ -- Should document these individual tests ???
+
if not Has_Default_Init_Comps (N)
and then Comes_From_Source (Parent (N))
and then Nkind (Parent (N)) = N_Object_Declaration
@@ -5170,7 +5137,13 @@
and then N = Expression (Parent (N))
and then not Is_Bit_Packed_Array (Typ)
and then not Has_Controlled_Component (Typ)
- and then not Has_Address_Clause (Parent (N))
+
+ -- If the aggregate is the expression in an object declaration, it
+ -- cannot be expanded in place. Lookahead in the current declarative
+ -- part to find an address clause for the object being declared. If
+ -- one is present, we cannot build in place. Unclear comment???
+
+ and then not Has_Following_Address_Clause (Parent (N))
then
Tmp := Defining_Identifier (Parent (N));
Set_No_Initialization (Parent (N));
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 160716)
+++ exp_ch3.adb (working copy)
@@ -4466,7 +4466,10 @@
-- it will be assigned subsequently. In particular, there is no point
-- in applying Initialize_Scalars to such a temporary.
- elsif Needs_Simple_Initialization (Typ)
+ elsif Needs_Simple_Initialization
+ (Typ,
+ Initialize_Scalars
+ and then not Has_Following_Address_Clause (N))
and then not Is_Internal (Def_Id)
and then not Has_Init_Expression (N)
then
@@ -8145,7 +8148,14 @@
-- Needs_Simple_Initialization --
---------------------------------
- function Needs_Simple_Initialization (T : Entity_Id) return Boolean is
+ function Needs_Simple_Initialization
+ (T : Entity_Id;
+ Consider_IS : Boolean := True) return Boolean
+ is
+ Consider_IS_NS : constant Boolean :=
+ Normalize_Scalars
+ or (Initialize_Scalars and Consider_IS);
+
begin
-- Check for private type, in which case test applies to the underlying
-- type of the private type.
@@ -8167,7 +8177,7 @@
-- types.
elsif Is_Access_Type (T)
- or else (Init_Or_Norm_Scalars and then (Is_Scalar_Type (T)))
+ or else (Consider_IS_NS and then (Is_Scalar_Type (T)))
then
return True;
@@ -8176,7 +8186,7 @@
-- expanding an aggregate (since in the latter case they will be
-- filled with appropriate initializing values before they are used).
- elsif Init_Or_Norm_Scalars
+ elsif Consider_IS_NS
and then
(Root_Type (T) = Standard_String
or else Root_Type (T) = Standard_Wide_String
Index: exp_ch3.ads
===================================================================
--- exp_ch3.ads (revision 160705)
+++ exp_ch3.ads (working copy)
@@ -126,14 +126,18 @@
-- then tags components located at variable positions of Target are
-- initialized.
- function Needs_Simple_Initialization (T : Entity_Id) return Boolean;
+ function Needs_Simple_Initialization
+ (T : Entity_Id;
+ Consider_IS : Boolean := True) return Boolean;
-- Certain types need initialization even though there is no specific
-- initialization routine. In this category are access types (which need
-- initializing to null), packed array types whose implementation is a
-- modular type, and all scalar types if Normalize_Scalars is set, as well
-- as private types whose underlying type is present and meets any of these
-- criteria. Finally, descendants of String and Wide_String also need
- -- initialization in Initialize/Normalize_Scalars mode.
+ -- initialization in Initialize/Normalize_Scalars mode. Consider_IS is
+ -- normally True. If it is False, the Initialize_Scalars is not considered
+ -- in determining whether simple initialization is needed.
function Get_Simple_Init_Val
(T : Entity_Id;
More information about the Gcc-patches
mailing list