This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix incompatibility Default_Scalar_Storage_Order/tagged types
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Eric Botcazou <ebotcazou at adacore dot com>
- Date: Tue, 17 Jul 2018 04:25:15 -0400
- Subject: [Ada] Fix incompatibility Default_Scalar_Storage_Order/tagged types
The pragma Default_Scalar_Storage_Order cannot reliably be used to set the
non-default scalar storage order for a program that declares tagged types, if
it also declares user-defined primitives.
This is fixed by making Make_Tags use the same base array type as Make_DT and
Make_Secondary_DT when accessing the array of user-defined primitives.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-07-17 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* exp_disp.adb (Make_Tags): When the type has user-defined primitives,
build the access type that is later used by Build_Get_Prim_Op_Address
as pointing to a subtype of Ada.Tags.Address_Array.
gcc/testsuite/
* gnat.dg/sso10.adb, gnat.dg/sso10_pkg.ads: New testcase.
--- gcc/ada/exp_disp.adb
+++ gcc/ada/exp_disp.adb
@@ -7179,7 +7179,7 @@ package body Exp_Disp is
Analyze_List (Result);
-- Generate:
- -- type Typ_DT is array (1 .. Nb_Prims) of Prim_Ptr;
+ -- subtype Typ_DT is Address_Array (1 .. Nb_Prims);
-- type Typ_DT_Acc is access Typ_DT;
else
@@ -7196,20 +7196,19 @@ package body Exp_Disp is
Name_DT_Prims_Acc);
begin
Append_To (Result,
- Make_Full_Type_Declaration (Loc,
+ Make_Subtype_Declaration (Loc,
Defining_Identifier => DT_Prims,
- Type_Definition =>
- Make_Constrained_Array_Definition (Loc,
- Discrete_Subtype_Definitions => New_List (
- Make_Range (Loc,
- Low_Bound => Make_Integer_Literal (Loc, 1),
- High_Bound => Make_Integer_Literal (Loc,
- DT_Entry_Count
- (First_Tag_Component (Typ))))),
- Component_Definition =>
- Make_Component_Definition (Loc,
- Subtype_Indication =>
- New_Occurrence_Of (RTE (RE_Prim_Ptr), Loc)))));
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (RTE (RE_Address_Array), Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint (Loc, New_List (
+ Make_Range (Loc,
+ Low_Bound => Make_Integer_Literal (Loc, 1),
+ High_Bound => Make_Integer_Literal (Loc,
+ DT_Entry_Count
+ (First_Tag_Component (Typ)))))))));
Append_To (Result,
Make_Full_Type_Declaration (Loc,
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/sso10.adb
@@ -0,0 +1,16 @@
+-- { dg-do run }
+
+with SSO10_Pkg; use SSO10_Pkg;
+
+procedure SSO10 is
+
+ procedure Inner (R : Root'Class) is
+ begin
+ Run (R);
+ end;
+
+ R : Root;
+
+begin
+ Inner (R);
+end;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/sso10_pkg.ads
@@ -0,0 +1,9 @@
+pragma Default_Scalar_Storage_Order (High_Order_First);
+
+package SSO10_Pkg is
+
+ type Root is tagged null record;
+
+ procedure Run (R : Root) is null;
+
+end SSO10_Pkg;