* [Ada] Fix incompatibility Default_Scalar_Storage_Order/tagged types
@ 2018-07-17 8:27 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2018-07-17 8:27 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
[-- Attachment #1: Type: text/plain, Size: 730 bytes --]
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 2596 bytes --]
--- 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2018-07-17 8:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-07-17 8:27 [Ada] Fix incompatibility Default_Scalar_Storage_Order/tagged types Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).