public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-604] [Ada] Improve error messages for occurrence of GNAT extensions without -gnatX
@ 2022-05-18 8:44 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-18 8:44 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:72de114c23027f1d1f0df4c78e69c4302e39e058
commit r13-604-g72de114c23027f1d1f0df4c78e69c4302e39e058
Author: Gary Dismukes <dismukes@adacore.com>
Date: Tue Apr 5 20:20:10 2022 -0400
[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:
---
gcc/ada/errout.adb | 15 +++++++++++----
gcc/ada/errout.ads | 7 ++++---
gcc/ada/par-ch11.adb | 2 +-
gcc/ada/par-ch12.adb | 2 +-
gcc/ada/par-ch3.adb | 7 ++++---
gcc/ada/par-ch4.adb | 11 ++++-------
gcc/ada/par-ch5.adb | 2 +-
gcc/ada/par-ch6.adb | 4 ++--
gcc/ada/sem_ch13.adb | 18 ++++--------------
9 files changed, 32 insertions(+), 36 deletions(-)
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index bc7c7d32db3..101aed435e6 100644
--- 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 ff363448f7b..c115a1ba533 100644
--- 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 cc10ba7aa1e..158050abc2c 100644
--- 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 991e93f3d10..fc76ad4dc70 100644
--- 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 d7d12554ffd..2359b8cd64a 100644
--- 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 bfefd144f21..e0f3ca934f1 100644
--- 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 91f2442f9d7..0421bd5d2ef 100644
--- 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 d972eadbda5..2832fd4a82e 100644
--- 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 ac94de7e84a..8bd0c866fd4 100644
--- 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)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-18 8:44 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-18 8:44 [gcc r13-604] [Ada] Improve error messages for occurrence of GNAT extensions without -gnatX Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).