This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix problem with VMS descriptor and generics
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Sat, 3 May 2008 21:48:45 +0200
- Subject: [Ada] Fix problem with VMS descriptor and generics
The compiler aborts during gimplification because there is a PLACEHOLDER_EXPR
left in the tree. The circumstances are quite convoluted: you need a variant
record + an unaligned component + a generic subprogram + a VMS descriptor.
It turns out that the component is in fact accidentally unaligned, because the
qualified union is built with default alignment (BITS_PER_UNIT)
gnu_union_type
= make_node (unchecked_union ? UNION_TYPE : QUAL_UNION_TYPE);
which causes the component to be made a bitfield, although it need not be.
Fixed by zeroing the alignment of the qualified union upon creating it. This
is already done for its fields recursively via the cancel_alignment argument
if (cancel_alignment)
TYPE_ALIGN (gnu_record_type) = 0;
Tested on i586-suse-linux, applied on the mainline.
2008-05-03 Eric Botcazou <ebotcazou@adacore.com>
* decl.c (components_to_record): Zero the alignment of the qualified
union built for the variant part upon creating it.
2008-05-03 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr6_pkg.ads: New helper.
* gnat.dg/discr6.adb: New test.
--
Eric Botcazou
Index: decl.c
===================================================================
--- decl.c (revision 134916)
+++ decl.c (working copy)
@@ -6322,6 +6322,7 @@ components_to_record (tree gnu_record_ty
= make_node (unchecked_union ? UNION_TYPE : QUAL_UNION_TYPE);
TYPE_NAME (gnu_union_type) = gnu_union_name;
+ TYPE_ALIGN (gnu_union_type) = 0;
TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
}
generic
type T(<>) is private;
package Discr6_Pkg is
function X (A : T) return Integer;
pragma Interface(C, X);
pragma IMPORT_FUNCTION (
INTERNAL => X,
EXTERNAL => X,
PARAMETER_TYPES => (T),
MECHANISM => (Descriptor(S)));
end Discr6_Pkg;
-- { dg-do compile }
-- { dg-options "-gnatdm -gnatws" }
with Discr6_Pkg;
procedure Discr6 is
type T_Bit is range 0..1;
type T_Entier_16 is range -2**15 .. 2**15-1;
package My_Q is new Discr6_Pkg(T_Entier_16);
type T_Valeur is (BIT, Entier_16);
type R(D : T_Valeur) is record
case D is
when BIT => V_BIT : T_Bit;
when Entier_16 => V_E16 : T_Entier_16;
end case;
end record;
for R use record
V_BIT at 0 range 0..7;
V_E16 at 0 range 0..15;
D at 8 range 0..7;
end record;
for R'size use 128;
A : R(Entier_16);
I : Integer;
begin
I := My_Q.X(A.V_E16);
end;