This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix ICE on bounded string subtype in packed record type
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Sat, 22 Nov 2014 13:22:46 +0100
- Subject: [Ada] Fix ICE on bounded string subtype in packed record type
- Authentication-results: sourceware.org; auth=none
The compiler aborts on an extension of a tagged record type which contains a
field whose type is a packed record type which in turn contains a field of a
bounded string subtype. Fixed by the attached tweak.
Tested on x86_64-suse-linux, applied on the mainline.
2014-11-22 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Call_to_gnu): Strip unchecked conversions on
actuals of In parameters if the destination type is an unconstrained
composite type.
2014-11-22 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/pack11.ads: New test.
--
Eric Botcazou
-- { dg-do compile }
with Ada.Strings.Bounded;
package Pack11 is
package My_Strings is new Ada.Strings.Bounded.Generic_Bounded_Length (4);
subtype My_Bounded_String is My_Strings.Bounded_String;
type Rec1 is tagged null record;
type Rec2 is record
S : My_Bounded_String;
end record;
pragma Pack (Rec2);
type Rec3 is new Rec1 with record
R : Rec2;
end record;
end Pack11;Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 217964)
+++ gcc-interface/trans.c (working copy)
@@ -4016,9 +4016,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
gnat_formal = Next_Formal_With_Extras (gnat_formal),
gnat_actual = Next_Actual (gnat_actual))
{
+ Entity_Id gnat_formal_type = Etype (gnat_formal);
tree gnu_formal = present_gnu_tree (gnat_formal)
? get_gnu_tree (gnat_formal) : NULL_TREE;
- tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
+ tree gnu_formal_type = gnat_to_gnu_type (gnat_formal_type);
const bool is_true_formal_parm
= gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL;
const bool is_by_ref_formal_parm
@@ -4031,13 +4032,16 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
address if it's passed by reference or as target of the back copy
done after the call if it uses the copy-in/copy-out mechanism.
We do it in the In case too, except for an unchecked conversion
- because it alone can cause the actual to be misaligned and the
- addressability test is applied to the real object. */
+ to an elementary type or a constrained composite type because it
+ alone can cause the actual to be misaligned and the addressability
+ test is applied to the real object. */
const bool suppress_type_conversion
= ((Nkind (gnat_actual) == N_Unchecked_Type_Conversion
- && Ekind (gnat_formal) != E_In_Parameter)
+ && (Ekind (gnat_formal) != E_In_Parameter
+ || (Is_Composite_Type (Underlying_Type (gnat_formal_type))
+ && !Is_Constrained (Underlying_Type (gnat_formal_type)))))
|| (Nkind (gnat_actual) == N_Type_Conversion
- && Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))));
+ && Is_Composite_Type (Underlying_Type (gnat_formal_type))));
Node_Id gnat_name = suppress_type_conversion
? Expression (gnat_actual) : gnat_actual;
tree gnu_name = gnat_to_gnu (gnat_name), gnu_name_type;
@@ -4200,7 +4204,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
if (Ekind (gnat_formal) != E_Out_Parameter
&& Do_Range_Check (gnat_actual))
gnu_actual
- = emit_range_check (gnu_actual, Etype (gnat_formal), gnat_actual);
+ = emit_range_check (gnu_actual, gnat_formal_type, gnat_actual);
/* Unless this is an In parameter, we must remove any justified modular
building from GNU_NAME to get an lvalue. */