[Ada] Improve error messages for occurrence of GNAT extensions without -gnatX

The error message issued for use of GNAT extension features without
specifying -gnatX (or pragma Extensions_Allowed) was confusing in the
presence of a pragma specifying a language version (such as "pragma
Ada_2022;"), because the pragma supersedes the switch.  The message is
improved by testing for use of such a pragma, plus use of pragma
Extensions_Allowed is now suggested, and several cases are changed to
call the common error procedure for flagging uses of extension features.

gcc/ada/

	* errout.ads (Error_Msg_GNAT_Extension): Add formal Loc and
	revise comment.
	* errout.adb (Error_Msg_GNAT_Extension): Condition message on
	the flag Ada_Version_Pragma, and add suggestion to use of pragma
	Extensions_Allowed in messages.
	* par-ch3.adb, par-ch5.adb, par-ch6.adb, par-ch11.adb,
	par-ch12.adb: Add actual Token_Ptr on calls to
	Error_Msg_GNAT_Extension.
	* par-ch4.adb: Change Error_Msg to Error_Msg_GNAT_Extension for
	error calls related to use of extension features.
	* sem_ch13.adb: Likewise.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index bc7c7d32db369dd102b9f558428ffbcd6158d6c6..101aed435e6ad967b991026a557c399a561911d7 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -896,12 +896,19 @@ package body Errout is
    -- Error_Msg_GNAT_Extension --
    ------------------------------
 
-   procedure Error_Msg_GNAT_Extension (Extension : String) is
-      Loc : constant Source_Ptr := Token_Ptr;
+   procedure Error_Msg_GNAT_Extension (Extension : String; Loc : Source_Ptr) is
    begin
       if not Extensions_Allowed then
-         Error_Msg (Extension & " is a 'G'N'A'T specific extension", Loc);
-         Error_Msg ("\unit must be compiled with -gnatX switch", Loc);
+         Error_Msg (Extension & " is a 'G'N'A'T-specific extension", Loc);
+
+         if No (Ada_Version_Pragma) then
+            Error_Msg ("\unit must be compiled with -gnatX "
+                       & "or use pragma Extensions_Allowed (On)", Loc);
+         else
+            Error_Msg_Sloc := Sloc (Ada_Version_Pragma);
+            Error_Msg ("\incompatible with Ada version set#", Loc);
+            Error_Msg ("\must use pragma Extensions_Allowed (On)", Loc);
+         end if;
       end if;
    end Error_Msg_GNAT_Extension;
 

diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index ff363448f7b0e7ece87d9ac58b545a80bfa538db..c115a1ba5332548cf722a6f4d66c11c7eb267c18 100644 (file)
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -943,10 +943,11 @@ package Errout is
    procedure Error_Msg_Ada_2022_Feature (Feature : String; Loc : Source_Ptr);
    --  Analogous to Error_Msg_Ada_2012_Feature, for Ada 2022
 
-   procedure Error_Msg_GNAT_Extension (Extension : String);
+   procedure Error_Msg_GNAT_Extension (Extension : String; Loc : Source_Ptr);
    --  If not operating with extensions allowed, posts errors complaining
-   --  that Extension is only supported when the -gnatX switch is enabled,
-   --  with appropriate suggestions to fix it.
+   --  that Extension is only supported when the -gnatX switch is enabled
+   --  or pragma Extensions_Allowed (On) is used. Loc indicates the source
+   --  location of the extension construct.
 
    procedure dmsg (Id : Error_Msg_Id) renames Erroutc.dmsg;
    --  Debugging routine to dump an error message

diff --git a/gcc/ada/par-ch11.adb b/gcc/ada/par-ch11.adb
index cc10ba7aa1e859b2e2733c2a27e957103cf94d2e..158050abc2cc86d8ffa88ae4d10f637825ab7481 100644 (file)
--- a/gcc/ada/par-ch11.adb
+++ b/gcc/ada/par-ch11.adb
@@ -234,7 +234,7 @@ package body Ch11 is
       end if;
 
       if Token = Tok_When then
-         Error_Msg_GNAT_Extension ("raise when statement");
+         Error_Msg_GNAT_Extension ("raise when statement", Token_Ptr);
 
          Mutate_Nkind (Raise_Node, N_Raise_When_Statement);
 

diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 991e93f3d102e1fae1230565a7ffdde81c5b1936..fc76ad4dc704c978ecda30ac94ccb8672138e7b4 100644 (file)
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -1225,7 +1225,7 @@ package body Ch12 is
 
          elsif Token = Tok_Left_Paren then
             Error_Msg_GNAT_Extension
-              ("expression default for formal subprograms");
+              ("expression default for formal subprograms", Token_Ptr);
 
             if Nkind (Spec_Node) = N_Function_Specification then
                Scan;  --  past "("

diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index d7d12554ffd4f7ea903a1b565214700881d8ef3d..2359b8cd64a818cb3e5181c2f0cb1de1280e01b0 100644 (file)
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -2788,7 +2788,7 @@ package body Ch3 is
             else
                P_Index_Subtype_Def_With_Fixed_Lower_Bound (Subtype_Mark_Node);
 
-               Error_Msg_GNAT_Extension ("fixed-lower-bound array");
+               Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr);
             end if;
 
             exit when Token = Tok_Right_Paren or else Token = Tok_Of;
@@ -2857,7 +2857,8 @@ package body Ch3 is
                      P_Index_Subtype_Def_With_Fixed_Lower_Bound
                        (Subtype_Mark_Node);
 
-                     Error_Msg_GNAT_Extension ("fixed-lower-bound array");
+                     Error_Msg_GNAT_Extension
+                       ("fixed-lower-bound array", Token_Ptr);
                   end if;
 
                   exit when Token = Tok_Right_Paren or else Token = Tok_Of;
@@ -3359,7 +3360,7 @@ package body Ch3 is
             --  later during analysis), and scan to the next token.
 
             if Token = Tok_Box then
-               Error_Msg_GNAT_Extension ("fixed-lower-bound array");
+               Error_Msg_GNAT_Extension ("fixed-lower-bound array", Token_Ptr);
 
                Expr_Node := Empty;
                Scan;

diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index bfefd144f21efbb637a5d4e9a6248d08f0be6f0c..e0f3ca934f15c3696f0382006b284f12643f60a0 100644 (file)
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -1783,9 +1783,8 @@ package body Ch4 is
                      Box_With_Identifier_Present := True;
                      Scan; -- past ">"
                   else
-                     Error_Msg
-                       ("Identifier within box only supported under -gnatX",
-                        Token_Ptr);
+                     Error_Msg_GNAT_Extension
+                       ("identifier within box", Token_Ptr);
                      Box_Present := True;
                      --  Avoid cascading errors by ignoring the identifier
                   end if;
@@ -1816,10 +1815,8 @@ package body Ch4 is
                Id := P_Defining_Identifier;
 
                if not Extensions_Allowed then
-                  Error_Msg
-                    ("IS following component association"
-                       & " only supported under -gnatX",
-                     Token_Ptr);
+                  Error_Msg_GNAT_Extension
+                    ("IS following component association", Token_Ptr);
                elsif Box_With_Identifier_Present then
                   Error_Msg
                     ("Both identifier-in-box and trailing identifier"

diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 91f2442f9d7c3b9bf11a91188084430545ffb092..0421bd5d2ef8aa37ff7237b12641b1b50720e43b 100644 (file)
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1975,7 +1975,7 @@ package body Ch5 is
       Append_Elmt (Goto_Node, Goto_List);
 
       if Token = Tok_When then
-         Error_Msg_GNAT_Extension ("goto when statement");
+         Error_Msg_GNAT_Extension ("goto when statement", Token_Ptr);
 
          Scan; -- past WHEN
          Mutate_Nkind (Goto_Node, N_Goto_When_Statement);

diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index d972eadbda51d8c7f7821a820ee4f462c37b97de..2832fd4a82e633ea822d7ffc31fd7ce4921752a2 100644 (file)
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -1999,7 +1999,7 @@ package body Ch6 is
             --  at a Return_when_statement
 
             if Token = Tok_When and then not Missing_Semicolon_On_When then
-               Error_Msg_GNAT_Extension ("return when statement");
+               Error_Msg_GNAT_Extension ("return when statement", Token_Ptr);
                Mutate_Nkind (Ret_Node, N_Return_When_Statement);
 
                Scan; -- past WHEN
@@ -2008,7 +2008,7 @@ package body Ch6 is
             --  Allow IF instead of WHEN, giving error message
 
             elsif Token = Tok_If then
-               Error_Msg_GNAT_Extension ("return when statement");
+               Error_Msg_GNAT_Extension ("return when statement", Token_Ptr);
                Mutate_Nkind (Ret_Node, N_Return_When_Statement);
 
                T_When;

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ac94de7e84a9e0c44657b4fbc1ff0d17cf4a59a1..8bd0c866fd4ef11a14dd959e48285ea4a6832f4c 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2601,10 +2601,8 @@ package body Sem_Ch13 is
                         Aspect);
 
                   elsif Is_Imported_Intrinsic then
-                     Error_Msg_N
-                       ("aspect % on intrinsic function is an extension: " &
-                        "use -gnatX",
-                        Aspect);
+                     Error_Msg_GNAT_Extension
+                       ("aspect % on intrinsic function", Sloc (Aspect));
 
                   else
                      Error_Msg_N
@@ -4411,11 +4409,7 @@ package body Sem_Ch13 is
 
                when Aspect_Designated_Storage_Model =>
                   if not Extensions_Allowed then
-                     Error_Msg_N
-                       ("aspect only allowed if extensions enabled",
-                        Aspect);
-                     Error_Msg_N
-                       ("\unit must be compiled with -gnatX switch", Aspect);
+                     Error_Msg_GNAT_Extension ("aspect %", Sloc (Aspect));
 
                   elsif not Is_Type (E)
                     or else Ekind (E) /= E_Access_Type
@@ -4430,11 +4424,7 @@ package body Sem_Ch13 is
 
                when Aspect_Storage_Model_Type =>
                   if not Extensions_Allowed then
-                     Error_Msg_N
-                       ("aspect only allowed if extensions enabled",
-                        Aspect);
-                     Error_Msg_N
-                       ("\unit must be compiled with -gnatX switch", Aspect);
+                     Error_Msg_GNAT_Extension ("aspect %", Sloc (Aspect));
 
                   elsif not Is_Type (E)
                     or else not Is_Immutably_Limited_Type (E)