From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id BF4F63857404; Wed, 18 May 2022 08:44:33 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BF4F63857404 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-604] [Ada] Improve error messages for occurrence of GNAT extensions without -gnatX X-Act-Checkin: gcc X-Git-Author: Gary Dismukes X-Git-Refname: refs/heads/master X-Git-Oldrev: b271095d5076f837391b2726c1265ae2e91fafa8 X-Git-Newrev: 72de114c23027f1d1f0df4c78e69c4302e39e058 Message-Id: <20220518084433.BF4F63857404@sourceware.org> Date: Wed, 18 May 2022 08:44:33 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 18 May 2022 08:44:33 -0000 https://gcc.gnu.org/g:72de114c23027f1d1f0df4c78e69c4302e39e058 commit r13-604-g72de114c23027f1d1f0df4c78e69c4302e39e058 Author: Gary Dismukes 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)