This fixes an internal error in the gimplifier when it is trying to generate
code for a CONSTRUCTOR of a record type with a component whose type contains
a variant part.
The handling of this kind of CONSTRUCTORs is delicate and the front-end has a
special circuitry to pre-decompose them (or rather aggregates, as they are
called in Ada) into assignments. This circuitry was recently adjusted to be
less conservative, so as to let the back-end build fully static objects in
more cases.
However, when they cannot be built statically because they contain non-static
parts, aggregates of this sort need always be pre-decomposed. The change
makes sure this is the case. But, in order not to go back too far on the
conservative side, it also enhances the circuitry that computes whether an
aggregate can be built statically or not.
The following code must compile quietly:
with Aggr4_Pkg; use Aggr4_Pkg;
package Aggr4 is
C : constant Rec3 := (Data => (D => One, Value => Zero));
end Aggr4;
package Aggr4_Pkg is
function F return Integer;
type Rec1 is tagged record
I : Integer;
end record;
Zero : constant Rec1 := (I => F);
type Enum is (One, Two);
type Rec2 (D : Enum := One) is record
case D is
when One => Value : Rec1;
when others => null;
end case;
end record;
type Rec3 is record
Data : Rec2;
end record;
end Aggr4_Pkg;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-02-08 Eric Botcazou <ebotca...@adacore.com>
* exp_aggr.adb (Compile_Time_Known_Composite_Value):
New predicate to compute whether a composite value can be
evaluated at compile time.
(Component_Not_OK_For_Backend): Use Compile_Time_Known_Value for all
expressions of elementary type and Compile_Time_Known_Composite_Value
for all other expressions.
(Expand_Record_Aggregate): Convert to assignments in the case
of a type with mutable components if the aggregate cannot be
built statically.
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 183996)
+++ exp_aggr.adb (working copy)
@@ -5115,6 +5115,14 @@
-- and the aggregate can be constructed statically and handled by
-- the back-end.
+ function Compile_Time_Known_Composite_Value (N : Node_Id) return Boolean;
+ -- Returns true if N is an expression of composite type which can be
+ -- fully evaluated at compile time without raising constraint error.
+ -- Such expressions can be passed as is to Gigi without any expansion.
+ --
+ -- This returns true for N_Aggregate with Compile_Time_Known_Aggregate
+ -- set and constants whose expression is such an aggregate, recursively.
+
function Component_Not_OK_For_Backend return Boolean;
-- Check for presence of component which makes it impossible for the
-- backend to process the aggregate, thus requiring the use of a series
@@ -5145,6 +5153,46 @@
-- For nested aggregates return the ultimate enclosing aggregate; for
-- non-nested aggregates return N.
+ ----------------------------------------
+ -- Compile_Time_Known_Composite_Value --
+ ----------------------------------------
+
+ function Compile_Time_Known_Composite_Value (N : Node_Id) return Boolean
+ is
+
+ begin
+ -- If we have an entity name, then see if it is the name of a
+ -- constant and if so, test the corresponding constant value.
+
+ if Is_Entity_Name (N) then
+ declare
+ E : constant Entity_Id := Entity (N);
+ V : Node_Id;
+
+ begin
+ if Ekind (E) /= E_Constant then
+ return False;
+ end if;
+
+ V := Constant_Value (E);
+ return Present (V)
+ and then Compile_Time_Known_Composite_Value (V);
+ end;
+
+ -- We have a value, see if it is compile time known
+
+ else
+ if Nkind (N) = N_Aggregate then
+ return Compile_Time_Known_Aggregate (N);
+ end if;
+
+ -- All other types of values are not known at compile time
+
+ return False;
+ end if;
+
+ end Compile_Time_Known_Composite_Value;
+
----------------------------------
-- Component_Not_OK_For_Backend --
----------------------------------
@@ -5201,14 +5249,12 @@
return True;
end if;
- if Is_Scalar_Type (Etype (Expr_Q)) then
+ if Is_Elementary_Type (Etype (Expr_Q)) then
if not Compile_Time_Known_Value (Expr_Q) then
Static_Components := False;
end if;
- elsif Nkind (Expr_Q) /= N_Aggregate
- or else not Compile_Time_Known_Aggregate (Expr_Q)
- then
+ elsif not Compile_Time_Known_Composite_Value (Expr_Q) then
Static_Components := False;
if Is_Private_Type (Etype (Expr_Q))
@@ -5374,12 +5420,14 @@
-- may be distinct from the default size of the type component, so
-- we need to expand to insure that the back-end copies the proper
-- size of the data. However, if the aggregate is the initial value of
- -- a constant, the target is immutable and may be built statically.
+ -- a constant, the target is immutable and might be built statically
+ -- if components are appropriate.
elsif Has_Mutable_Components (Typ)
and then
(Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
- or else not Constant_Present (Parent (Top_Level_Aggr)))
+ or else not Constant_Present (Parent (Top_Level_Aggr))
+ or else not Static_Components)
then
Convert_To_Assignments (N, Typ);
