From 19f51f28fcb611671a103412b53c9fd04b1f4848 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 22 Nov 2014 12:23:47 +0000 Subject: [PATCH] trans.c (Call_to_gnu): Strip unchecked conversions on actuals of In parameters if... * gcc-interface/trans.c (Call_to_gnu): Strip unchecked conversions on actuals of In parameters if the destination type is an unconstrained composite type. From-SVN: r217965 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/gcc-interface/trans.c | 16 ++++++++++------ gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/specs/pack11.ads | 21 +++++++++++++++++++++ 4 files changed, 41 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/specs/pack11.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 881c2f8f7ef..3cde2d8d434 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2014-11-22 Eric Botcazou + + * 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 * gcc-interface/trans.c (gnat_gimplify_expr): Add 'type' variable. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3d27dde709f..1888c194006 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4016,9 +4016,10 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, 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 *gnu_result_type_p, tree gnu_target, 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 *gnu_result_type_p, tree gnu_target, 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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 80deed0d419..5d5706b0b5c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2014-11-22 Eric Botcazou + + * gnat.dg/specs/pack11.ads: New test. + 2014-11-22 Eric Botcazou * gnat.dg/specs/no_streams.ads: New test. diff --git a/gcc/testsuite/gnat.dg/specs/pack11.ads b/gcc/testsuite/gnat.dg/specs/pack11.ads new file mode 100644 index 00000000000..9a25ec4d431 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/pack11.ads @@ -0,0 +1,21 @@ +-- { 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; -- 2.30.2