--- gcc/ada/exp_imgv.adb +++ 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); --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/sso16.adb @@ -0,0 +1,55 @@ +-- { dg-do run } + +with Ada.Text_IO; use Ada.Text_IO; + +procedure SSO16 is + + pragma Default_Scalar_Storage_Order (High_Order_First); + + type Enum_T is + (Event_0, + Event_1, + Event_2, + Event_3, + Event_4, + Event_5, + Event_11, + Event_12, + Event_13, + Event_14, + Event_15, + Event_21, + Event_22, + Event_23, + Event_24, + Event_25, + Event_31, + Event_32, + Event_33, + Event_34, + Event_35, + Event_41, + Event_42, + Event_43, + Event_44, + Event_45); + + Var : Enum_T := Event_0; + +begin + if Var'Image /= "EVENT_0" then + raise Program_Error; + end if; + + if Enum_T'Value ("Event_4")'Image /= "EVENT_4" then + raise Program_Error; + end if; + + if Enum_T'Val (20)'Image /= "EVENT_35" then + raise Program_Error; + end if; + + if Enum_T'Pos (Enum_T'Value ("Event_45"))'Image /= " 25" then + raise Program_Error; + end if; +end;