diff options
| author | Justin Squirek <squirek@adacore.com> | 2019-07-08 08:12:55 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-08 08:12:55 +0000 |
| commit | ffec45e390555f4881c841271464a9c264adbbca (patch) | |
| tree | d9a26463ee898d86646270a7aea40a0cc27f9692 /gcc/ada | |
| parent | 0a90412010e4bd535df8c35d4bce95f321ebb6be (diff) | |
| download | gcc-ffec45e390555f4881c841271464a9c264adbbca.zip gcc-ffec45e390555f4881c841271464a9c264adbbca.tar.gz gcc-ffec45e390555f4881c841271464a9c264adbbca.tar.bz2 | |
[Ada] Crash on Image and Value attributes
This patch fixes an issue whereby the creation of an enumeration within
package where Default_Scalar_Storage_Order is in effect may lead to a
crash when the attributes Image or Value are applied to objects of said
type or the type directly.
2019-07-08 Justin Squirek <squirek@adacore.com>
gcc/ada/
* exp_imgv.adb (Build_Enumeration_Image_Tables): Default SSO for
the building of image tables.
(Expand_Image_Attribute): Minor cleanup.
gcc/testsuite/
* gnat.dg/sso16.adb: New testcase.
From-SVN: r273199
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/exp_imgv.adb | 38 |
2 files changed, 35 insertions, 9 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b1b2e48..528556a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-07-08 Justin Squirek <squirek@adacore.com> + + * exp_imgv.adb (Build_Enumeration_Image_Tables): Default SSO for + the building of image tables. + (Expand_Image_Attribute): Minor cleanup. + 2019-07-08 Dmitriy Anisimkov <anisimko@adacore.com> * libgnat/g-socket.ads, libgnat/g-socket.adb: Improve diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 6a8d626..a47de2f 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -69,18 +69,23 @@ package body Exp_Imgv is ------------------------------------ procedure Build_Enumeration_Image_Tables (E : Entity_Id; N : Node_Id) is - Loc : constant Source_Ptr := Sloc (E); - Str : String_Id; + Loc : constant Source_Ptr := Sloc (E); + + Eind : Entity_Id; + Estr : Entity_Id; Ind : List_Id; + Ityp : Node_Id; + Len : Nat; Lit : Entity_Id; Nlit : Nat; - Len : Nat; - Estr : Entity_Id; - Eind : Entity_Id; - Ityp : Node_Id; + Str : String_Id; + + Saved_SSO : constant Character := Opt.Default_SSO; + -- Used to save the current scalar storage order during the generation + -- of the literal lookup table. begin - -- Nothing to do for other than a root enumeration type + -- Nothing to do for types other than a root enumeration type if E /= Root_Type (E) then return; @@ -138,6 +143,15 @@ package body Exp_Imgv is Set_Lit_Strings (E, Estr); Set_Lit_Indexes (E, Eind); + -- Temporarily set the current scalar storage order to the default + -- during the generation of the literals table, since both the Image and + -- Value attributes rely on runtime routines for interpreting table + -- values. + + Opt.Default_SSO := ' '; + + -- Generate literal table + Insert_Actions (N, New_List ( Make_Object_Declaration (Loc, @@ -168,6 +182,10 @@ package body Exp_Imgv is Make_Aggregate (Loc, Expressions => Ind))), Suppress => All_Checks); + + -- Reset the scalar storage order to the saved value + + Opt.Default_SSO := Saved_SSO; end Build_Enumeration_Image_Tables; ---------------------------- @@ -433,13 +451,13 @@ package body Exp_Imgv is -- Local variables + Enum_Case : Boolean; Imid : RE_Id; + Proc_Ent : Entity_Id; Ptyp : Entity_Id; Rtyp : Entity_Id; Tent : Entity_Id := Empty; Ttyp : Entity_Id; - Proc_Ent : Entity_Id; - Enum_Case : Boolean; Arg_List : List_Id; -- List of arguments for run-time procedure call @@ -450,6 +468,8 @@ package body Exp_Imgv is Snn : constant Entity_Id := Make_Temporary (Loc, 'S'); Pnn : constant Entity_Id := Make_Temporary (Loc, 'P'); + -- Start of processing for Expand_Image_Attribute + begin if Is_Object_Image (Pref) then Rewrite_Object_Image (N, Pref, Name_Image, Standard_String); |