This change fixes a compiler crash occurring in some cases of constant
declarations initialized with a call to an instance of a generic function,
when the returned type is an array of dynamically sized elements.
The following compilation must be accepted quietly:
$ gcc -c p.adb
package Q is
function F return Integer;
subtype Comp is String (1 .. F);
type Element_T is record
C : Comp;
end record;
end Q;
with Q;
procedure P is
type Exist_Element_T (Exist : Boolean := False) is record
case Exist is
when True => Value : Q.Element_T;
when False => null;
end case;
end record;
type Arr is array (Boolean) of Exist_Element_T;
generic
type Idx is (<>);
type Elmt is private;
type Arr is array (Idx) of Elmt;
function F_G return Arr;
function F_G return Arr is
A : Elmt;
begin
return Arr'(others => A);
end F_G;
function F is new F_G (Idx => Boolean, Elmt => Exist_Element_T, Arr => Arr);
Const_Arr : constant Arr := F;
begin
null;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-01-22 Thomas Quinot <qui...@adacore.com>
* sem_ch3.adb (Analyze_Object_Declaration): For a constant
declaration initialized with a function call, whose type
has variable size, need to remove side effects so that the
initialization expression becomes a dereference of a temporary
reference to the function result.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 206923)
+++ sem_ch3.adb (working copy)
@@ -2991,6 +2991,11 @@
-- or a variant record type is encountered, Check_Restrictions is called
-- indicating the count is unknown.
+ function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
+ -- True if T has discriminants and is unconstrained, or is an array
+ -- type whose element type Has_Unconstrained_Elements. Shouldn't this
+ -- be in sem_util???
+
-----------------
-- Count_Tasks --
-----------------
@@ -3045,6 +3050,24 @@
end if;
end Count_Tasks;
+ --------------------------------
+ -- Has_Unconstrained_Elements --
+ --------------------------------
+
+ function Has_Unconstrained_Elements (T : Entity_Id) return Boolean is
+ U_T : constant Entity_Id := Underlying_Type (T);
+ begin
+ if No (U_T) then
+ return False;
+ elsif Is_Record_Type (U_T) then
+ return Has_Discriminants (U_T) and then not Is_Constrained (U_T);
+ elsif Is_Array_Type (U_T) then
+ return Has_Unconstrained_Elements (Component_Type (U_T));
+ else
+ return False;
+ end if;
+ end Has_Unconstrained_Elements;
+
-- Start of processing for Analyze_Object_Declaration
begin
@@ -3647,16 +3670,15 @@
Rewrite (Object_Definition (N), New_Occurrence_Of (Act_T, Loc));
- elsif Present (Underlying_Type (T))
- and then not Is_Constrained (Underlying_Type (T))
- and then Has_Discriminants (Underlying_Type (T))
- and then Nkind (E) = N_Function_Call
+ elsif Nkind (E) = N_Function_Call
and then Constant_Present (N)
+ and then Has_Unconstrained_Elements (Etype (E))
then
-- The back-end has problems with constants of a discriminated type
-- with defaults, if the initial value is a function call. We
- -- generate an intermediate temporary for the result of the call.
- -- It is unclear why this should make it acceptable to gcc. ???
+ -- generate an intermediate temporary that will receive a reference
+ -- to the result of the call. The initialization expression then
+ -- becomes a dereference of that temporary.
Remove_Side_Effects (E);
