[Ada] Ada2020: wording of 'Image messages

gcc/ada/

	* errout.ads, errout.adb (Error_Msg_Ada_2020_Feature): New
	procedure analogous to Error_Msg_Ada_2012_Feature.
	* sem_attr.adb (Analyze_Image_Attribute): Use
	Error_Msg_Ada_2012_Feature and Error_Msg_Ada_2020_Feature to
	indicate that Object'Image is allowed in Ada 2012, and that
	'Image is allowed for any type in Ada 2020.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 0f46ab6..1063d7d 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -630,6 +630,24 @@ package body Errout is
       end if;
    end Error_Msg_Ada_2012_Feature;
 
+   --------------------------------
+   -- Error_Msg_Ada_2020_Feature --
+   --------------------------------
+
+   procedure Error_Msg_Ada_2020_Feature (Feature : String; Loc : Source_Ptr) is
+   begin
+      if Ada_Version < Ada_2020 then
+         Error_Msg (Feature & " is an Ada 2020 feature", Loc);
+
+         if No (Ada_Version_Pragma) then
+            Error_Msg ("\unit must be compiled with -gnat2020 switch", Loc);
+         else
+            Error_Msg_Sloc := Sloc (Ada_Version_Pragma);
+            Error_Msg ("\incompatible with Ada version set#", Loc);
+         end if;
+      end if;
+   end Error_Msg_Ada_2020_Feature;
+
    ------------------
    -- Error_Msg_AP --
    ------------------

diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 1591a37..83a23cc 100644 (file)
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -895,12 +895,15 @@ package Errout is
    --  first formal (RM 9.4(11.9/3)).
 
    procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr);
-   --  If not operating in Ada 2012 mode, posts errors complaining that Feature
-   --  is only supported in Ada 2012, with appropriate suggestions to fix this.
-   --  Loc is the location at which the flag is to be posted. Feature, which
-   --  appears at the start of the first generated message, may contain error
-   --  message insertion characters in the normal manner, and in particular
-   --  may start with | to flag a non-serious error.
+   --  If not operating in Ada 2012 mode or higher, posts errors complaining
+   --  that Feature is only supported in Ada 2012, with appropriate suggestions
+   --  to fix this. Loc is the location at which the flag is to be posted.
+   --  Feature, which appears at the start of the first generated message, may
+   --  contain error message insertion characters in the normal manner, and in
+   --  particular may start with | to flag a non-serious error.
+
+   procedure Error_Msg_Ada_2020_Feature (Feature : String; Loc : Source_Ptr);
+   --  Analogous to Error_Msg_Ada_2012_Feature
 
    procedure dmsg (Id : Error_Msg_Id) renames Erroutc.dmsg;
    --  Debugging routine to dump an error message

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index b35f2b6..e3c027d 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1457,16 +1457,11 @@ package body Sem_Attr is
 
          procedure Check_Image_Type (Image_Type : Entity_Id) is
          begin
-            if Ada_Version >= Ada_2020 then
-               null; -- all types are OK
-            elsif not Is_Scalar_Type (Image_Type) then
-               if Ada_Version >= Ada_2012 then
-                  Error_Attr_P
-                    ("prefix of % attribute must be a scalar type or a scalar "
-                       & "object name");
-               else
-                  Error_Attr_P ("prefix of % attribute must be a scalar type");
-               end if;
+            if Ada_Version < Ada_2020
+              and then not Is_Scalar_Type (Image_Type)
+            then
+               Error_Msg_Ada_2020_Feature ("|nonscalar ''Image", Sloc (P));
+               Error_Attr;
             end if;
          end Check_Image_Type;
 
@@ -1483,7 +1478,7 @@ package body Sem_Attr is
             Check_Image_Type (Etype (P));
 
             if Attr_Id /= Attribute_Img and then Ada_Version < Ada_2012 then
-               Error_Attr_P ("prefix of % attribute must be a scalar type");
+               Error_Msg_Ada_2012_Feature ("|Object''Image", Sloc (P));
             end if;
          else
             Check_E1;