The compiler crashes on the declaration of a constant with discriminated record
type and variable size, if the constant is initialized to an aggregate which
assigns the length of an array with variable size to a discriminant. The
problem is again an incorrect sharing of a tree node between two types.
Tested on i586-suse-linux, applied on the mainline.
2011-03-26 Eric Botcazou <[email protected]>
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Create TYPE_DECL
for the padded type built to support a specified size or alignment.
2011-03-26 Eric Botcazou <[email protected]>
* gnat.dg/discr27.ad[sb]: New test.
--
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 171552)
+++ gcc-interface/decl.c (working copy)
@@ -911,9 +911,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
size of the object. */
gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
if (gnu_size || align > 0)
- gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
- false, false, definition,
- gnu_size ? true : false);
+ {
+ tree orig_type = gnu_type;
+
+ gnu_type = maybe_pad_type (gnu_type, gnu_size, align, gnat_entity,
+ false, false, definition,
+ gnu_size ? true : false);
+
+ /* If a padding record was made, declare it now since it will
+ never be declared otherwise. This is necessary to ensure
+ that its subtrees are properly marked. */
+ if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
+ create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
+ debug_info_p, gnat_entity);
+ }
/* If this is a renaming, avoid as much as possible to create a new
object. However, in several cases, creating it is required.
package body Discr27 is
subtype Index is Positive range 1..4096;
function F return String is
S : String(1..1) := (others =>'w');
begin
return S;
end;
type Enum is (One, Two);
type Rec (D : Enum := One; Len : Index := 1) is record
case D is
when One => I : Integer;
when Two => A : String(1..Len);
end case;
end record;
procedure Nothing is
M : constant String := F;
C : constant Rec := (Two, M'Length, M);
begin
null;
end;
procedure Proc is begin
null;
end;
end Discr27;
-- { dg-do compile }
package Discr27 is
procedure Proc;
end Discr27;
