[Ada] Small cleanup in the Expand_Image_Attribute procedure

gcc/ada/

	* exp_imgv.adb (Is_User_Defined_Enumeration_Type): Delete.
	(Expand_Image_Attribute): Move inline expansion into normal flow of
	control, move down declarations and remove superfluous processing.

diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index b35562c..c8d0384 100644 (file)
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -761,10 +761,6 @@ package body Exp_Imgv is
       --  Expand attribute 'Image in user-defined enumeration types, avoiding
       --  string copy.
 
-      function Is_User_Defined_Enumeration_Type
-        (Typ : Entity_Id) return Boolean;
-      --  Return True if Typ is a user-defined enumeration type
-
       -----------------------------------
       -- Expand_Standard_Boolean_Image --
       -----------------------------------
@@ -837,7 +833,7 @@ package body Exp_Imgv is
              Name                =>
                Make_If_Expression (Loc,
                  Expressions => New_List (
-                   Relocate_Node (Expr),
+                   Duplicate_Subexpr (Expr),
                    New_Occurrence_Of (T_Id, Loc),
                    New_Occurrence_Of (F_Id, Loc)))));
 
@@ -1005,20 +1001,6 @@ package body Exp_Imgv is
          Analyze_And_Resolve (N, Standard_String);
       end Expand_User_Defined_Enumeration_Image;
 
-      --------------------------------------
-      -- Is_User_Defined_Enumeration_Type --
-      --------------------------------------
-
-      function Is_User_Defined_Enumeration_Type
-        (Typ : Entity_Id) return Boolean is
-      begin
-         return Ekind (Typ) = E_Enumeration_Type
-           and then Typ /= Standard_Boolean
-           and then Typ /= Standard_Character
-           and then Typ /= Standard_Wide_Character
-           and then Typ /= Standard_Wide_Wide_Character;
-      end Is_User_Defined_Enumeration_Type;
-
       --  Local variables
 
       Enum_Case : Boolean;
@@ -1060,46 +1042,6 @@ package body Exp_Imgv is
          Rtyp := Underlying_Type (Base_Type (Ptyp));
       end if;
 
-      --  Use inline expansion for user-defined enumeration types for which
-      --  the literal string entity has been built, and if -gnatd_x is not
-      --  passed to the compiler. Otherwise the attribute will be expanded
-      --  into a call to a routine in the runtime.
-
-      if Is_User_Defined_Enumeration_Type (Rtyp)
-        and then Present (Lit_Strings (Rtyp))
-        and then not Debug_Flag_Underscore_X
-      then
-         Expand_User_Defined_Enumeration_Image (Rtyp);
-         return;
-      end if;
-
-      --  Build declarations of Snn and Pnn to be inserted
-
-      Ins_List := New_List (
-
-         --  Snn : String (1 .. typ'Width);
-
-         Make_Object_Declaration (Loc,
-            Defining_Identifier => Snn,
-            Object_Definition   =>
-              Make_Subtype_Indication (Loc,
-                Subtype_Mark => New_Occurrence_Of (Standard_String, Loc),
-                Constraint   =>
-                  Make_Index_Or_Discriminant_Constraint (Loc,
-                    Constraints => New_List (
-                      Make_Range (Loc,
-                        Low_Bound  => Make_Integer_Literal (Loc, 1),
-                        High_Bound =>
-                          Make_Attribute_Reference (Loc,
-                            Prefix         => New_Occurrence_Of (Rtyp, Loc),
-                            Attribute_Name => Name_Width)))))),
-
-         --  Pnn : Natural;
-
-         Make_Object_Declaration (Loc,
-           Defining_Identifier => Pnn,
-           Object_Definition   => New_Occurrence_Of (Standard_Natural, Loc)));
-
       --  Set Imid (RE_Id of procedure to call), and Tent, target for the
       --  type conversion of the first argument for all possibilities.
 
@@ -1266,9 +1208,14 @@ package body Exp_Imgv is
             Analyze_And_Resolve (N, Standard_String);
             return;
 
-         else
-            --  Here for enumeration type case
+         --  Use inline expansion if the -gnatd_x switch is not passed to the
+         --  compiler. Otherwise expand into a call to the runtime.
+
+         elsif not Debug_Flag_Underscore_X then
+            Expand_User_Defined_Enumeration_Image (Rtyp);
+            return;
 
+         else
             Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp)));
 
             if Ttyp = Standard_Integer_8 then
@@ -1295,25 +1242,11 @@ package body Exp_Imgv is
       --  Build first argument for call
 
       if Enum_Case then
-         declare
-            T : Entity_Id;
-         begin
-            --  In Ada 2020 we need the underlying type here, because 'Image is
-            --  allowed on private types. We have already checked the version
-            --  when resolving the attribute.
-
-            if Is_Private_Type (Ptyp) then
-               T := Rtyp;
-            else
-               T := Ptyp;
-            end if;
-
-            Arg_List := New_List (
-              Make_Attribute_Reference (Loc,
-                Attribute_Name => Name_Pos,
-                Prefix         => New_Occurrence_Of (T, Loc),
-                Expressions    => New_List (Expr)));
-         end;
+         Arg_List := New_List (
+           Make_Attribute_Reference (Loc,
+             Attribute_Name => Name_Pos,
+             Prefix         => New_Occurrence_Of (Ptyp, Loc),
+             Expressions    => New_List (Expr)));
 
       --  AI12-0020: Ada 2020 allows 'Image for all types, including private
       --  types. If the full type is not a fixed-point type, then it is enough
@@ -1325,6 +1258,7 @@ package body Exp_Imgv is
       else
          declare
             Conv : Node_Id;
+
          begin
             if Is_Private_Type (Etype (Expr)) then
                if Is_Fixed_Point_Type (Rtyp) then
@@ -1340,6 +1274,33 @@ package body Exp_Imgv is
          end;
       end if;
 
+      --  Build declarations of Snn and Pnn to be inserted
+
+      Ins_List := New_List (
+
+         --  Snn : String (1 .. typ'Width);
+
+         Make_Object_Declaration (Loc,
+            Defining_Identifier => Snn,
+            Object_Definition   =>
+              Make_Subtype_Indication (Loc,
+                Subtype_Mark => New_Occurrence_Of (Standard_String, Loc),
+                Constraint   =>
+                  Make_Index_Or_Discriminant_Constraint (Loc,
+                    Constraints => New_List (
+                      Make_Range (Loc,
+                        Low_Bound  => Make_Integer_Literal (Loc, 1),
+                        High_Bound =>
+                          Make_Attribute_Reference (Loc,
+                            Prefix         => New_Occurrence_Of (Rtyp, Loc),
+                            Attribute_Name => Name_Width)))))),
+
+         --  Pnn : Natural;
+
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => Pnn,
+           Object_Definition   => New_Occurrence_Of (Standard_Natural, Loc)));
+
       --  Append Snn, Pnn arguments
 
       Append_To (Arg_List, New_Occurrence_Of (Snn, Loc));