ada: Fix crash on 'Img as generic actual function

'Image is allowed as an actual for a generic formal function.
This patch fixes a crash when 'Img is used instead of 'Image
in that context.

Misc cleanups.

gcc/ada/

	* exp_put_image.adb (Build_Image_Call): Treat 'Img the same as
	'Image.
	* exp_imgv.adb (Expand_Image_Attribute): If Discard_Names, expand
	to 'Image instead of 'Img.
	* snames.ads-tmpl, par-ch4.adb, sem_attr.adb, sem_attr.ads:
	Cleanups: Rename Attribute_Class_Array to be Attribute_Set. Remove
	unnecessary qualifications. DRY: Don't repeat "True".

diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 257f65badd0df0fc3714cb28f0c552f54dd282cc..a31ce1d8c8fd69e0f7e070b5c2d21bf74a125b96 100644 (file)
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -762,7 +762,7 @@ package body Exp_Imgv is
    --  Snn (1 .. Pnn) then occurs as in the other cases. A special case is
    --  when pragma Discard_Names applies, in which case we replace expr by:
 
-   --     (rt'Pos (expr))'Img
+   --     (rt'Pos (expr))'Image
 
    --  So that the result is a space followed by the decimal value for the
    --  position of the enumeration value in the enumeration type.
@@ -1211,8 +1211,8 @@ package body Exp_Imgv is
            or else No (Lit_Strings (Rtyp))
          then
             --  When pragma Discard_Names applies to the first subtype, build
-            --  (Long_Long_Integer (Pref'Pos (Expr)))'Img. The conversion is
-            --  there to avoid applying 'Img directly in Universal_Integer,
+            --  (Long_Long_Integer (Pref'Pos (Expr)))'Image. The conversion is
+            --  there to avoid applying 'Image directly in Universal_Integer,
             --  which can be a very large type. See also the handling of 'Val.
 
             Rewrite (N,
@@ -1223,8 +1223,7 @@ package body Exp_Imgv is
                     Prefix         => Pref,
                     Attribute_Name => Name_Pos,
                     Expressions    => New_List (Expr))),
-                Attribute_Name =>
-                  Name_Img));
+                Attribute_Name => Name_Image));
             Analyze_And_Resolve (N, Standard_String);
             return;
 

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index c194237aa20f4cac21ca8c9606937a5ca6e285cb..9eda3231c6b6a6fa1a7b900f8b0c7a4b7ec0dab9 100644 (file)
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -1126,7 +1126,9 @@ package body Exp_Put_Image is
       --  Attribute names that will be mapped to the corresponding result types
       --  and functions.
 
-      Attribute_Name_Id : constant Name_Id := Attribute_Name (N);
+      Attribute_Name_Id : constant Name_Id :=
+        (if Attribute_Name (N) = Name_Img then Name_Image
+         else Attribute_Name (N));
 
       Result_Typ    : constant Entity_Id :=
         (case Image_Name_Id'(Attribute_Name_Id) is

diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 2505eb629ab90bce7dc02c4c776b922296311330..52f2b02361a59681b868f8eee30cd9d0790f7c58 100644 (file)
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -34,17 +34,17 @@ package body Ch4 is
 
    --  Attributes that cannot have arguments
 
-   Is_Parameterless_Attribute : constant Attribute_Class_Array :=
-     (Attribute_Base         => True,
-      Attribute_Body_Version => True,
-      Attribute_Class        => True,
-      Attribute_External_Tag => True,
-      Attribute_Img          => True,
-      Attribute_Loop_Entry   => True,
-      Attribute_Old          => True,
-      Attribute_Result       => True,
-      Attribute_Stub_Type    => True,
-      Attribute_Version      => True,
+   Is_Parameterless_Attribute : constant Attribute_Set :=
+     (Attribute_Base         |
+      Attribute_Body_Version |
+      Attribute_Class        |
+      Attribute_External_Tag |
+      Attribute_Img          |
+      Attribute_Loop_Entry   |
+      Attribute_Old          |
+      Attribute_Result       |
+      Attribute_Stub_Type    |
+      Attribute_Version      |
       Attribute_Type_Key     => True,
       others                 => False);
    --  This map contains True for parameterless attributes that return a string

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 39103279fa7b6c1d5a2974c64997404f41de17ac..8257d4b3536fc37ff5a66dac8b6c33e7ad79d7d1 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -104,8 +104,8 @@ package body Sem_Attr is
    --  In Ada 83 mode, these are the only recognized attributes. In other Ada
    --  modes all these attributes are recognized, even if removed in Ada 95.
 
-   Attribute_83 : constant Attribute_Class_Array := Attribute_Class_Array'(
-      Attribute_Address                      |
+   Attribute_83 : constant Attribute_Set :=
+     (Attribute_Address                      |
       Attribute_Aft                          |
       Attribute_Alignment                    |
       Attribute_Base                         |
@@ -153,8 +153,8 @@ package body Sem_Attr is
    --  RM which are not defined in Ada 95. These are recognized in Ada 95 mode,
    --  but in Ada 95 they are considered to be implementation defined.
 
-   Attribute_05 : constant Attribute_Class_Array := Attribute_Class_Array'(
-      Attribute_Machine_Rounding             |
+   Attribute_05 : constant Attribute_Set :=
+     (Attribute_Machine_Rounding             |
       Attribute_Mod                          |
       Attribute_Priority                     |
       Attribute_Stream_Size                  |
@@ -165,8 +165,8 @@ package body Sem_Attr is
    --  RM which are not defined in Ada 2005. These are recognized in Ada 95
    --  and Ada 2005 modes, but are considered to be implementation defined.
 
-   Attribute_12 : constant Attribute_Class_Array := Attribute_Class_Array'(
-      Attribute_First_Valid                  |
+   Attribute_12 : constant Attribute_Set :=
+     (Attribute_First_Valid                  |
       Attribute_Has_Same_Storage             |
       Attribute_Last_Valid                   |
       Attribute_Max_Alignment_For_Allocation => True,
@@ -176,10 +176,10 @@ package body Sem_Attr is
    --  RM which are not defined in Ada 2012. These are recognized in Ada
    --  95/2005/2012 modes, but are considered to be implementation defined.
 
-   Attribute_22 : constant Attribute_Class_Array := Attribute_Class_Array'(
-      Attribute_Enum_Rep                     |
-      Attribute_Enum_Val                     => True,
-      Attribute_Index                        => True,
+   Attribute_22 : constant Attribute_Set :=
+     (Attribute_Enum_Rep                     |
+      Attribute_Enum_Val                     |
+      Attribute_Index                        |
       Attribute_Preelaborable_Initialization => True,
       others                                 => False);
 
@@ -187,9 +187,8 @@ package body Sem_Attr is
    --  of their prefixes or result in an access value. Such prefixes can be
    --  considered as lvalues.
 
-   Attribute_Name_Implies_Lvalue_Prefix : constant Attribute_Class_Array :=
-      Attribute_Class_Array'(
-      Attribute_Access                       |
+   Attribute_Name_Implies_Lvalue_Prefix : constant Attribute_Set :=
+     (Attribute_Access                       |
       Attribute_Address                      |
       Attribute_Input                        |
       Attribute_Read                         |

diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index b7a05713ed1a5a942b77f268fd3bd9c8708135d6..f383ab50000d9a0c49aa84b62acfb27440b7b5ab 100644 (file)
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -46,8 +46,8 @@ package Sem_Attr is
    --  in GNAT, as well as constructing an array of flags indicating which
    --  attributes these are.
 
-   Attribute_Impl_Def : constant Attribute_Class_Array :=
-     Attribute_Class_Array'(
+   Attribute_Impl_Def : constant Attribute_Set :=
+     (
 
       ------------------
       -- Abort_Signal --

diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 9868d97b74089e7c5c3c9885ab5a774720e93eb5..9d17b43802e1d053259747bda29b5bd287d8f9d3 100644 (file)
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -1643,7 +1643,7 @@ package Snames is
    subtype Internal_Attribute_Id is Attribute_Id
      range Attribute_CPU .. Attribute_Interrupt_Priority;
 
-   type Attribute_Class_Array is array (Attribute_Id) of Boolean;
+   type Attribute_Set is array (Attribute_Id) of Boolean;
    --  Type used to build attribute classification flag arrays
 
    ------------------------------------