From fecf597290f2253558aa24395cc96753fa11811f Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Thu, 14 Nov 2024 17:51:41 +0100 Subject: [PATCH 1/8] minor: Remove the 'SLOC_Error' procedure Remove it because it is not used. --- lkql_checker/src/gnatcheck-output.adb | 22 ---------------------- lkql_checker/src/gnatcheck-output.ads | 6 ------ 2 files changed, 28 deletions(-) diff --git a/lkql_checker/src/gnatcheck-output.adb b/lkql_checker/src/gnatcheck-output.adb index 093aa6cf8..9f94a8477 100644 --- a/lkql_checker/src/gnatcheck-output.adb +++ b/lkql_checker/src/gnatcheck-output.adb @@ -616,28 +616,6 @@ package body Gnatcheck.Output is end if; end Set_XML_Report_File_Name; - ---------------- - -- SLOC_Error -- - ---------------- - - procedure SLOC_Error - (Message : String; - SLOC : String) is - begin - Put (Standard_Error, SLOC & ": "); - if Log_Mode and then Is_Open (Log_File) then - Put (Log_File, SLOC & ": "); - end if; - - Put (Standard_Error, Executable & ": "); - - if Log_Mode and then Is_Open (Log_File) then - Put (Log_File, Executable & ": "); - end if; - - Error_No_Tool_Name (Message); - end SLOC_Error; - ------------- -- Warning -- ------------- diff --git a/lkql_checker/src/gnatcheck-output.ads b/lkql_checker/src/gnatcheck-output.ads index a874dba37..41e12256e 100644 --- a/lkql_checker/src/gnatcheck-output.ads +++ b/lkql_checker/src/gnatcheck-output.ads @@ -47,12 +47,6 @@ package Gnatcheck.Output is -- Same as ``Error`` but send the message only if Stderr is a TTY. Also, -- ``Message`` is not added to the stderr log file. - procedure SLOC_Error - (Message : String; - SLOC : String); - -- Sends to Stderr the error message in the following format: - -- 'SLOC:Tool_Name:Message', where SLOC is the GNAT-style source location. - procedure Warning (Message : String); -- Same as Error, but do nothing if Warning_Mode = Quiet. From 85a1760c93d25fd65c8c0d61cca3a51deab4908a Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Mon, 18 Nov 2024 12:00:30 +0100 Subject: [PATCH 2/8] minor: Simplify the 'Print_Tool_Version' procedure --- lkql_checker/src/gnatcheck-output.adb | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/lkql_checker/src/gnatcheck-output.adb b/lkql_checker/src/gnatcheck-output.adb index 9f94a8477..a82fdbbc0 100644 --- a/lkql_checker/src/gnatcheck-output.adb +++ b/lkql_checker/src/gnatcheck-output.adb @@ -321,18 +321,17 @@ package body Gnatcheck.Output is procedure Print_Tool_Version (Released_At : Positive) is begin if Gnatkp_Mode then - Put ("GNATKP " & Date); + Put_Line ("GNATKP " & Date); else - Put ("GNATCHECK " & Version_String); + Put_Line ("GNATCHECK " & Version_String); end if; - New_Line; - Put ("Copyright (C) "); - Put (Image (Released_At)); - Put ('-'); - Put (Current_Year); - Put (", AdaCore."); - New_Line; + Put_Line + ("Copyright (C) " & + Image (Released_At) & + '-' & + Current_Year & + ", AdaCore."); end Print_Tool_Version; ------------------------ From 5033bf3a13a7dc7ffc3c24d06feb4a7a528c1e0b Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Thu, 14 Nov 2024 17:41:20 +0100 Subject: [PATCH 3/8] Fix the error traceback display The emission condition was reversed. --- lkql_checker/src/gnatcheck-output.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lkql_checker/src/gnatcheck-output.adb b/lkql_checker/src/gnatcheck-output.adb index a82fdbbc0..7e84117ea 100644 --- a/lkql_checker/src/gnatcheck-output.adb +++ b/lkql_checker/src/gnatcheck-output.adb @@ -427,7 +427,7 @@ package body Gnatcheck.Output is procedure Report_Unhandled_Exception (Ex : Exception_Occurrence) is begin Error (Exception_Message (Ex)); - if not Arg.Debug_Mode.Get then + if Arg.Debug_Mode.Get then Put_Line (Standard_Error, GNAT.Traceback.Symbolic.Symbolic_Traceback_No_Hex (Ex)); From 42904fa901bba023e01b2c8da17c97be8be1f689 Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Fri, 15 Nov 2024 12:16:47 +0100 Subject: [PATCH 4/8] Fix emission of the '-rules' depreciation message Avoid multiple emission of this message and categories it as an information message, not an error. --- lkql_checker/src/gnatcheck-output.adb | 22 +++++++++---------- lkql_checker/src/gnatcheck-output.ads | 8 +++---- lkql_checker/src/gnatcheck-projects.adb | 5 +++-- .../rules_depreciation_message/test.out | 4 ++-- 4 files changed, 20 insertions(+), 19 deletions(-) diff --git a/lkql_checker/src/gnatcheck-output.adb b/lkql_checker/src/gnatcheck-output.adb index 7e84117ea..eaa20de9f 100644 --- a/lkql_checker/src/gnatcheck-output.adb +++ b/lkql_checker/src/gnatcheck-output.adb @@ -123,17 +123,6 @@ package body Gnatcheck.Output is end if; end Error_No_Tool_Name; - ------------------ - -- Error_In_Tty -- - ------------------ - - procedure Error_In_Tty (Message : String) is - begin - if isatty (fileno (stderr)) /= 0 then - Put_Line (Standard_Error, Executable & ": " & Message); - end if; - end Error_In_Tty; - ----------------------- -- Get_Indent_String -- ----------------------- @@ -314,6 +303,17 @@ package body Gnatcheck.Output is end if; end Info_No_EOL; + ----------------- + -- Info_In_Tty -- + ----------------- + + procedure Info_In_Tty (Message : String) is + begin + if isatty (fileno (stderr)) /= 0 then + Put_Line (Standard_Error, Message); + end if; + end Info_In_Tty; + ------------------------ -- Print_Tool_Version -- ------------------------ diff --git a/lkql_checker/src/gnatcheck-output.ads b/lkql_checker/src/gnatcheck-output.ads index 41e12256e..03d50bfba 100644 --- a/lkql_checker/src/gnatcheck-output.ads +++ b/lkql_checker/src/gnatcheck-output.ads @@ -43,10 +43,6 @@ package Gnatcheck.Output is procedure Error_No_Tool_Name (Message : String); -- Sends into Stderr the error message with no tool name prefix - procedure Error_In_Tty (Message : String); - -- Same as ``Error`` but send the message only if Stderr is a TTY. Also, - -- ``Message`` is not added to the stderr log file. - procedure Warning (Message : String); -- Same as Error, but do nothing if Warning_Mode = Quiet. @@ -71,6 +67,10 @@ package Gnatcheck.Output is -- that is, the last line does not contain a (platform-specific) EOL -- character(s). + procedure Info_In_Tty (Message : String); + -- Same as ``Info`` but send the message only if Stderr is a TTY. Also, + -- ``Message`` is not added to the current ``Log_File``. + Indent_String : constant String := " "; -- Used as indentation element in various output diff --git a/lkql_checker/src/gnatcheck-projects.adb b/lkql_checker/src/gnatcheck-projects.adb index 9170f55c5..28b32442a 100644 --- a/lkql_checker/src/gnatcheck-projects.adb +++ b/lkql_checker/src/gnatcheck-projects.adb @@ -1212,13 +1212,14 @@ package body Gnatcheck.Projects is Individual_Rules_Set := True; end case; if not Rules_Depreciation_Emitted then - Error_In_Tty + Info_In_Tty ("The '-rules' section is now deprecated. You should only " & "use the '--rule' and '--rule-file' command-line options."); - Error_In_Tty + Info_In_Tty ("You can use the '--emit-lkql-rule-file' flag to " & "automatically translate your rule configuration to the " & "new LKQL format."); + Rules_Depreciation_Emitted := True; end if; end loop; end Process_Sections; diff --git a/testsuite/tests/gnatcheck/rules_depreciation_message/test.out b/testsuite/tests/gnatcheck/rules_depreciation_message/test.out index dcb5799ad..220cad74e 100644 --- a/testsuite/tests/gnatcheck/rules_depreciation_message/test.out +++ b/testsuite/tests/gnatcheck/rules_depreciation_message/test.out @@ -1,3 +1,3 @@ -gnatcheck: The '-rules' section is now deprecated. You should only use the '--rule' and '--rule-file' command-line options. -gnatcheck: You can use the '--emit-lkql-rule-file' flag to automatically translate your rule configuration to the new LKQL format. +The '-rules' section is now deprecated. You should only use the '--rule' and '--rule-file' command-line options. +You can use the '--emit-lkql-rule-file' flag to automatically translate your rule configuration to the new LKQL format. main.adb:3:04: goto statement From 8d56f9d52f83dfd4e69c09b12a76637fe3a98e57 Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Fri, 15 Nov 2024 12:42:29 +0100 Subject: [PATCH 5/8] Remove useless parameters in 'Info' and 'Info_No_EOL' Remove those parameters because they were not used. Also change 'Current_Error' calls into 'Standard_Error' calls to stick with other message emission procedures. --- lkql_checker/src/gnatcheck-output.adb | 301 ++++++++++---------------- lkql_checker/src/gnatcheck-output.ads | 26 +-- lkql_checker/src/gnatcheck-rules.adb | 8 +- 3 files changed, 120 insertions(+), 215 deletions(-) diff --git a/lkql_checker/src/gnatcheck-output.adb b/lkql_checker/src/gnatcheck-output.adb index eaa20de9f..b21d5d80e 100644 --- a/lkql_checker/src/gnatcheck-output.adb +++ b/lkql_checker/src/gnatcheck-output.adb @@ -202,13 +202,10 @@ package body Gnatcheck.Output is -- Info -- ---------- - procedure Info - (Message : String; - Line_Len : Natural := 0; - Spacing : Natural := 0) is + procedure Info (Message : String) is begin - Info_No_EOL (Message, Line_Len, Spacing); - New_Line (Current_Error); + Info_No_EOL (Message); + New_Line (Standard_Error); if Log_Mode and then Is_Open (Log_File) then New_Line (Log_File); @@ -219,87 +216,12 @@ package body Gnatcheck.Output is -- Info_No_EOL -- ----------------- - procedure Info_No_EOL - (Message : String; - Line_Len : Natural := 0; - Spacing : Natural := 0) - is - Start_Idx : constant Natural := Message'First; - End_Idx : Natural := Message'Last; - Start_From : Positive; - + procedure Info_No_EOL (Message : String) is begin - if Line_Len = 0 - or else - End_Idx - Start_Idx + 1 <= Line_Len - then - Put (Current_Error, Message); - - if Log_Mode and then Is_Open (Log_File) then - Put (Log_File, Message); - end if; - - else - -- Define which part of the Message can be placed into one line: - while End_Idx >= Start_Idx - and then - not (Message (End_Idx) = ' ' - and then - End_Idx - Start_Idx + 1 <= Line_Len) - loop - End_Idx := End_Idx - 1; - end loop; - - if End_Idx < Start_Idx then - -- Cannot split Message, so: - Put (Current_Error, Message); - - if Log_Mode and then Is_Open (Log_File) then - Put (Log_File, Message); - end if; + Put (Standard_Error, Message); - else - -- Index of the beginning of the remaining part of Message - Start_From := End_Idx + 1; - - -- Now move End_Idx to the left to skip spaces: - - while End_Idx >= Start_Idx - and then - Message (End_Idx) = ' ' - loop - End_Idx := End_Idx - 1; - end loop; - - Put (Current_Error, Message (Start_Idx .. End_Idx)); - - if Log_Mode and then Is_Open (Log_File) then - Put (Log_File, Message (Start_Idx .. End_Idx)); - end if; - - -- Skip spaces in the remaining part of the message, if any: - End_Idx := Message'Last; - - while Start_From <= End_Idx - and then - Message (Start_From) = ' ' - loop - Start_From := Start_From + 1; - end loop; - - if Start_From <= End_Idx then - New_Line (Current_Error); - - if Log_Mode and then Is_Open (Log_File) then - New_Line (Log_File); - end if; - - Info_No_EOL - (Message => Spacing * ' ' & Message (Start_From .. End_Idx), - Line_Len => Line_Len, - Spacing => Spacing); - end if; - end if; + if Log_Mode and then Is_Open (Log_File) then + Put (Log_File, Message); end if; end Info_No_EOL; @@ -653,117 +575,117 @@ package body Gnatcheck.Output is pragma Style_Checks ("M200"); -- Allow long lines if Gnatkp_Mode then - Info ("gnatkp: the GNAT known problem detector"); - Info ("usage: gnatkp -Pproject [options] [-rules [-from=file] {+Rkp_id[:param]}]"); - Info ("options:"); - Info (" --version - Display version and exit"); - Info (" --help - Display usage and exit"); - Info (""); - Info (" -Pproject - Use project file project. Only one such switch can be used"); - Info (" -U - check all sources of the argument project"); - Info (" -U main - check the closure of units rooted at unit main"); - Info (" --no-subprojects - process only sources of root project"); - Info (" -Xname=value - specify an external reference for argument project file"); - Info (" --subdirs=dir - specify subdirectory to place the result files into"); - Info (" -eL - follow all symbolic links when processing project files"); - Info (" -o filename - specify the name of the report file"); - Info (""); - Info (" --target=targetname - specify a target for cross platforms"); - Info (" --RTS= - use runtime "); - Info (""); - Info (" -h - print out the list of the available kp detectors"); - Info (" -jn - n is the maximal number of processes"); - Info (" -q - quiet mode (do not report detections in Stderr)"); - Info (" -v - verbose mode"); - Info (" -l - full pathname for file locations"); - Info (""); - Info (" --brief - brief mode, only report detections in Stderr"); - Info (" --check-semantic - check semantic validity of the source files"); - Info (" --charset= - specify the charset of the source files"); - Info (" --kp-version= - enable all KP detectors matching GNAT "); - Info (" --rule-file=filename - read kp configuration from the given LKQL file"); - Info (" -r, --rule [kp_id] - enable the given kp detector during the GNATKP run (this option is cumulative)"); - Info (""); - Info (" -from=filename - read kp options from filename"); - Info (" +R[:param] - turn ON a given detector [with given parameter]"); - Info (" where - ID of one of the currently implemented"); - Info (" detectors, use '-h' for the full list"); - Info (""); - Info ("KP detectors must be specified either implicitly via --kp-version "); - Info ("(and optionally --target), or explicitly via -rules"); + Put_Line ("gnatkp: the GNAT known problem detector"); + Put_Line ("usage: gnatkp -Pproject [options] [-rules [-from=file] {+Rkp_id[:param]}]"); + Put_Line ("options:"); + Put_Line (" --version - Display version and exit"); + Put_Line (" --help - Display usage and exit"); + Put_Line (""); + Put_Line (" -Pproject - Use project file project. Only one such switch can be used"); + Put_Line (" -U - check all sources of the argument project"); + Put_Line (" -U main - check the closure of units rooted at unit main"); + Put_Line (" --no-subprojects - process only sources of root project"); + Put_Line (" -Xname=value - specify an external reference for argument project file"); + Put_Line (" --subdirs=dir - specify subdirectory to place the result files into"); + Put_Line (" -eL - follow all symbolic links when processing project files"); + Put_Line (" -o filename - specify the name of the report file"); + Put_Line (""); + Put_Line (" --target=targetname - specify a target for cross platforms"); + Put_Line (" --RTS= - use runtime "); + Put_Line (""); + Put_Line (" -h - print out the list of the available kp detectors"); + Put_Line (" -jn - n is the maximal number of processes"); + Put_Line (" -q - quiet mode (do not report detections in Stderr)"); + Put_Line (" -v - verbose mode"); + Put_Line (" -l - full pathname for file locations"); + Put_Line (""); + Put_Line (" --brief - brief mode, only report detections in Stderr"); + Put_Line (" --check-semantic - check semantic validity of the source files"); + Put_Line (" --charset= - specify the charset of the source files"); + Put_Line (" --kp-version= - enable all KP detectors matching GNAT "); + Put_Line (" --rule-file=filename - read kp configuration from the given LKQL file"); + Put_Line (" -r, --rule [kp_id] - enable the given kp detector during the GNATKP run (this option is cumulative)"); + Put_Line (""); + Put_Line (" -from=filename - read kp options from filename"); + Put_Line (" +R[:param] - turn ON a given detector [with given parameter]"); + Put_Line (" where - ID of one of the currently implemented"); + Put_Line (" detectors, use '-h' for the full list"); + Put_Line (""); + Put_Line ("KP detectors must be specified either implicitly via --kp-version "); + Put_Line ("(and optionally --target), or explicitly via -rules"); return; end if; - Info ("gnatcheck: the GNAT rule checking tool"); - Info ("usage: gnatcheck [options] {filename} {-files=filename} -rules rule_switches [-cargs gcc_switches]"); - Info ("options:"); - Info (" --version - Display version and exit"); - Info (" --help - Display usage and exit"); - Info (""); - Info (" -Pproject - Use project file project. Only one such switch can be used"); - Info (" -U - check all sources of the argument project"); - Info (" -U main - check the closure of units rooted at unit main"); - Info (" --no-subprojects - process only sources of root project"); - Info (" -Xname=value - specify an external reference for argument project file"); - Info (" --subdirs=dir - specify subdirectory to place the result files into"); - Info (" --no_objects_dir - place results into current dir instead of project dir"); - Info (" -eL - follow all symbolic links when processing project files"); - Info (""); - Info (" --ignore-project-switches - ignore switches specified in the project file"); - Info (" --target=targetname - specify a target for cross platforms"); - Info (" --RTS= - use runtime "); - Info (" --config= - use configuration project "); - Info (""); - Info (" -h - print out the list of the currently implemented rules"); - Info (" -mn - n is the maximal number of diagnoses in Stderr"); - Info (" (n in 0 .. 1000, 0 means no limit); default is 0"); - Info (" -jn - n is the maximal number of processes"); - Info (" -q - quiet mode (do not report detections in Stderr)"); - Info (" -t - report execution time in Stderr"); - Info (" -v - verbose mode"); - Info (" -l - full pathname for file locations"); - Info (" -log - duplicate all the messages sent to Stderr in gnatcheck.log"); - Info (" -s - short form of the report file"); - Info (" -xml - generate report in XML format"); - Info (" -nt - do not generate text report (enforces '-xml')"); - Info (""); - Info (" --show-rule - append rule names to diagnoses generated"); - Info (" --show-instantiation-chain - show instantiation chain for reported generic construct"); - Info (""); - Info (" --brief - brief mode, only report detections in Stderr"); - Info (" --check-redefinition - issue warning if a rule parameter is redefined"); - Info (" --check-semantic - check semantic validity of the source files"); - Info (" --charset= - specify the charset of the source files"); + Put_Line ("gnatcheck: the GNAT rule checking tool"); + Put_Line ("usage: gnatcheck [options] {filename} {-files=filename} -rules rule_switches [-cargs gcc_switches]"); + Put_Line ("options:"); + Put_Line (" --version - Display version and exit"); + Put_Line (" --help - Display usage and exit"); + Put_Line (""); + Put_Line (" -Pproject - Use project file project. Only one such switch can be used"); + Put_Line (" -U - check all sources of the argument project"); + Put_Line (" -U main - check the closure of units rooted at unit main"); + Put_Line (" --no-subprojects - process only sources of root project"); + Put_Line (" -Xname=value - specify an external reference for argument project file"); + Put_Line (" --subdirs=dir - specify subdirectory to place the result files into"); + Put_Line (" --no_objects_dir - place results into current dir instead of project dir"); + Put_Line (" -eL - follow all symbolic links when processing project files"); + Put_Line (""); + Put_Line (" --ignore-project-switches - ignore switches specified in the project file"); + Put_Line (" --target=targetname - specify a target for cross platforms"); + Put_Line (" --RTS= - use runtime "); + Put_Line (" --config= - use configuration project "); + Put_Line (""); + Put_Line (" -h - print out the list of the currently implemented rules"); + Put_Line (" -mn - n is the maximal number of diagnoses in Stderr"); + Put_Line (" (n in 0 .. 1000, 0 means no limit); default is 0"); + Put_Line (" -jn - n is the maximal number of processes"); + Put_Line (" -q - quiet mode (do not report detections in Stderr)"); + Put_Line (" -t - report execution time in Stderr"); + Put_Line (" -v - verbose mode"); + Put_Line (" -l - full pathname for file locations"); + Put_Line (" -log - duplicate all the messages sent to Stderr in gnatcheck.log"); + Put_Line (" -s - short form of the report file"); + Put_Line (" -xml - generate report in XML format"); + Put_Line (" -nt - do not generate text report (enforces '-xml')"); + Put_Line (""); + Put_Line (" --show-rule - append rule names to diagnoses generated"); + Put_Line (" --show-instantiation-chain - show instantiation chain for reported generic construct"); + Put_Line (""); + Put_Line (" --brief - brief mode, only report detections in Stderr"); + Put_Line (" --check-redefinition - issue warning if a rule parameter is redefined"); + Put_Line (" --check-semantic - check semantic validity of the source files"); + Put_Line (" --charset= - specify the charset of the source files"); if not Legacy then - Info (" --rules-dir= - specify an alternate directory containing rule files"); + Put_Line (" --rules-dir= - specify an alternate directory containing rule files"); end if; - Info (""); - Info (" --include-file=filename - add the content of filename into generated report"); - Info (""); - Info (" -o filename - specify the name of the text report file"); - Info (" -ox filename - specify the name of the XML report file (enforces '-xml')"); - Info (""); - Info (" filename - the name of the Ada source file to be analyzed."); - Info (" Wildcards are allowed"); - Info (" -files=filename - the name of the text file containing a list of Ada"); - Info (" source files to analyze"); - Info (" --ignore=filename - do not process sources listed in filename"); - Info (" --rule-file=filename - read rule configuration from the given LKQL file"); - Info (" -r, --rule [rule_name] - enable the given rule during the GNATcheck run (this option is cumulative)"); - Info (" --emit-lkql-rule-file - emit a 'rules.lkql' file containing the rules configuration"); - Info (""); - Info ("rule_switches - a list of the following switches"); - Info (" -from=filename - read rule options from filename"); - Info (" +R[:param] - turn ON a given rule [with given parameter]"); - Info (" -R - turn OFF a given rule"); - Info (" -R:param - turn OFF some of the checks for a given rule,"); - Info (" depending on the specified parameter"); - Info ("where - ID of one of the currently implemented"); - Info (" rules, use '-h' for the full list"); - Info (" param - string representing parameter(s) of a given rule, more than "); - Info (" one parameter can be set separated by ','"); + Put_Line (""); + Put_Line (" --include-file=filename - add the content of filename into generated report"); + Put_Line (""); + Put_Line (" -o filename - specify the name of the text report file"); + Put_Line (" -ox filename - specify the name of the XML report file (enforces '-xml')"); + Put_Line (""); + Put_Line (" filename - the name of the Ada source file to be analyzed."); + Put_Line (" Wildcards are allowed"); + Put_Line (" -files=filename - the name of the text file containing a list of Ada"); + Put_Line (" source files to analyze"); + Put_Line (" --ignore=filename - do not process sources listed in filename"); + Put_Line (" --rule-file=filename - read rule configuration from the given LKQL file"); + Put_Line (" -r, --rule [rule_name] - enable the given rule during the GNATcheck run (this option is cumulative)"); + Put_Line (" --emit-lkql-rule-file - emit a 'rules.lkql' file containing the rules configuration"); + Put_Line (""); + Put_Line ("rule_switches - a list of the following switches"); + Put_Line (" -from=filename - read rule options from filename"); + Put_Line (" +R[:param] - turn ON a given rule [with given parameter]"); + Put_Line (" -R - turn OFF a given rule"); + Put_Line (" -R:param - turn OFF some of the checks for a given rule,"); + Put_Line (" depending on the specified parameter"); + Put_Line ("where - ID of one of the currently implemented"); + Put_Line (" rules, use '-h' for the full list"); + Put_Line (" param - string representing parameter(s) of a given rule, more than "); + Put_Line (" one parameter can be set separated by ','"); pragma Style_Checks ("M79"); end Brief_Help; @@ -774,7 +696,6 @@ package body Gnatcheck.Output is procedure Print_Gnatcheck_Usage is begin - Set_Error (Standard_Output); Brief_Help; New_Line; Put_Line ("Report bugs to report@adacore.com"); diff --git a/lkql_checker/src/gnatcheck-output.ads b/lkql_checker/src/gnatcheck-output.ads index 03d50bfba..59ec6ec7b 100644 --- a/lkql_checker/src/gnatcheck-output.ads +++ b/lkql_checker/src/gnatcheck-output.ads @@ -46,26 +46,12 @@ package Gnatcheck.Output is procedure Warning (Message : String); -- Same as Error, but do nothing if Warning_Mode = Quiet. - procedure Info - (Message : String; - Line_Len : Natural := 0; - Spacing : Natural := 0); - -- Sends Message as a separate line(s) into Stderr (with no tool name - -- prefix). If Line_Len is set to some positive value, it is treated as a - -- maximal length of the text to be placed into one output line, and if the - -- length of Message exceeds Line_Len, this procedure tries to split - -- Message treating spaces as word separators and prints the rest of the - -- Message on the next line(s). Each continuation line starts from Spacing - -- number of space characters. Message can be split only on borders of - -- words. - - procedure Info_No_EOL - (Message : String; - Line_Len : Natural := 0; - Spacing : Natural := 0); - -- The same as Info, but does not "close" the last line being printed out, - -- that is, the last line does not contain a (platform-specific) EOL - -- character(s). + procedure Info (Message : String); + -- Sends Message into Stderr (with no tool name prefix). + + procedure Info_No_EOL (Message : String); + -- The same as ``Info``, but does not output a (platform-specific) EOL + -- character(s) after ``Message``. procedure Info_In_Tty (Message : String); -- Same as ``Info`` but send the message only if Stderr is a TTY. Also, diff --git a/lkql_checker/src/gnatcheck-rules.adb b/lkql_checker/src/gnatcheck-rules.adb index d23b92925..5be6918f1 100644 --- a/lkql_checker/src/gnatcheck-rules.adb +++ b/lkql_checker/src/gnatcheck-rules.adb @@ -2804,11 +2804,9 @@ package body Gnatcheck.Rules is procedure Print_Rule_Help (Rule : Rule_Info) is begin Info - (Message => - " " & Rule_Name (Rule) & " - " & - To_String (Rule.Help_Info) & " - " & - Rule.Remediation_Level'Img, - Line_Len => 0, Spacing => 0); + (" " & Rule_Name (Rule) & " - " & + To_String (Rule.Help_Info) & " - " & + Rule.Remediation_Level'Img); end Print_Rule_Help; --------------------------------------- From 688bc4748ff037cbac5952a08dee5609e7adab22 Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Fri, 15 Nov 2024 14:22:28 +0100 Subject: [PATCH 6/8] Change the 'instance help' message kind to 'info' Do this because the 'warning' kind is not the valid one for this message. --- lkql_checker/src/gnatcheck-rules-rule_table.adb | 4 ++-- .../tests/gnatcheck_errors/same_name_instances/test.out | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/lkql_checker/src/gnatcheck-rules-rule_table.adb b/lkql_checker/src/gnatcheck-rules-rule_table.adb index f91df4a4c..81a23b7bc 100644 --- a/lkql_checker/src/gnatcheck-rules-rule_table.adb +++ b/lkql_checker/src/gnatcheck-rules-rule_table.adb @@ -1052,9 +1052,9 @@ package body Gnatcheck.Rules.Rule_Table is then To_String (Instance.Defined_At) else "command line") & Diag_Defined_At); if not Instance_Help_Emitted then - Warning + Info ("if you want to pass multiple parameters to a rule you " & - "should use the comma separated notation: e.g. " & + "should use the comma separated notation: e.g. " & "+RMy_Rule:Param1,Param2"); Instance_Help_Emitted := True; end if; diff --git a/testsuite/tests/gnatcheck_errors/same_name_instances/test.out b/testsuite/tests/gnatcheck_errors/same_name_instances/test.out index 286187064..7b645fef9 100644 --- a/testsuite/tests/gnatcheck_errors/same_name_instances/test.out +++ b/testsuite/tests/gnatcheck_errors/same_name_instances/test.out @@ -2,7 +2,7 @@ In rule options =============== gnatcheck: rule instance with the same name already exists: "same_alias" previously instantiated at command line -gnatcheck: if you want to pass multiple parameters to a rule you should use the comma separated notation: e.g. +RMy_Rule:Param1,Param2 +if you want to pass multiple parameters to a rule you should use the comma separated notation: e.g. +RMy_Rule:Param1,Param2 gnatcheck: rule instance with the same name already exists: "comp_check" previously instantiated at command line gnatcheck: rule instance with the same name already exists: "comp_check" previously instantiated at command line >>>program returned status code 5 @@ -11,12 +11,12 @@ In command-line =============== gnatcheck: rule instance with the same name already exists: "goto_statements" previously instantiated at command line -gnatcheck: if you want to pass multiple parameters to a rule you should use the comma separated notation: e.g. +RMy_Rule:Param1,Param2 +if you want to pass multiple parameters to a rule you should use the comma separated notation: e.g. +RMy_Rule:Param1,Param2 >>>program returned status code 5 In command-line and rule options ================================ gnatcheck: rule instance with the same name already exists: "goto_statements" previously instantiated at command line (rules.txt:1:1) -gnatcheck: if you want to pass multiple parameters to a rule you should use the comma separated notation: e.g. +RMy_Rule:Param1,Param2 +if you want to pass multiple parameters to a rule you should use the comma separated notation: e.g. +RMy_Rule:Param1,Param2 >>>program returned status code 5 From 19c129acf89929a584fb05b7c9fbb2ffa31e7983 Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Fri, 15 Nov 2024 14:54:13 +0100 Subject: [PATCH 7/8] Add '-W/--warnings-as-errors' flag to GNATcheck --- .../doc/gnatcheck_rm/using_gnatcheck.rst | 6 +++ lkql_checker/src/gnatcheck-options.ads | 6 +++ lkql_checker/src/gnatcheck-output.adb | 47 +++++++++++-------- lkql_checker/src/gnatcheck-output.ads | 4 ++ lkql_checker/src/gnatcheck_main.adb | 35 +++++++------- .../gnatcheck/warnings_as_errors/main.adb | 5 ++ .../gnatcheck/warnings_as_errors/rules.lkql | 4 ++ .../gnatcheck/warnings_as_errors/test.out | 12 +++++ .../gnatcheck/warnings_as_errors/test.yaml | 10 ++++ 9 files changed, 93 insertions(+), 36 deletions(-) create mode 100644 testsuite/tests/gnatcheck/warnings_as_errors/main.adb create mode 100644 testsuite/tests/gnatcheck/warnings_as_errors/rules.lkql create mode 100644 testsuite/tests/gnatcheck/warnings_as_errors/test.out create mode 100644 testsuite/tests/gnatcheck/warnings_as_errors/test.yaml diff --git a/lkql_checker/doc/gnatcheck_rm/using_gnatcheck.rst b/lkql_checker/doc/gnatcheck_rm/using_gnatcheck.rst index 0cc9aee9e..baa02beed 100644 --- a/lkql_checker/doc/gnatcheck_rm/using_gnatcheck.rst +++ b/lkql_checker/doc/gnatcheck_rm/using_gnatcheck.rst @@ -270,6 +270,12 @@ The following switches control the general ``gnatcheck`` behavior Verbose mode; ``gnatcheck`` generates version information and then a trace of sources being processed. + .. index:: -W + +``-W, --warnings-as-errors`` + Treat warnings raised by GNATcheck as errors, ensuring an erroneous return + code. + .. index:: -o ``-o report_file`` diff --git a/lkql_checker/src/gnatcheck-options.ads b/lkql_checker/src/gnatcheck-options.ads index 50d3a100f..b72763a47 100644 --- a/lkql_checker/src/gnatcheck-options.ads +++ b/lkql_checker/src/gnatcheck-options.ads @@ -466,6 +466,12 @@ package Gnatcheck.Options is Help => "emit a 'rules.lkql' file containing the rules " & "configuration"); + package Warnings_As_Errors is new Parse_Flag + (Parser => Parser, + Long => "--warnings-as-errors", + Short => "-W", + Help => "Treat warning messages as errors"); + function Quiet_Mode return Boolean is (Quiet.Get or else Brief.Get); function Short_Report return Boolean is (Brief.Get or else Short.Get); diff --git a/lkql_checker/src/gnatcheck-output.adb b/lkql_checker/src/gnatcheck-output.adb index b21d5d80e..8a838c4f6 100644 --- a/lkql_checker/src/gnatcheck-output.adb +++ b/lkql_checker/src/gnatcheck-output.adb @@ -543,9 +543,14 @@ package body Gnatcheck.Output is procedure Warning (Message : String) is begin - if Warning_Mode /= Quiet then + if Arg.Warnings_As_Errors.Get or else Warning_Mode /= Quiet then Error (Message); end if; + + -- Force a non-zero return code when "warnings as errors" is enabled + if Arg.Warnings_As_Errors.Get then + Error_From_Warning := True; + end if; end Warning; ---------------- @@ -593,11 +598,12 @@ package body Gnatcheck.Output is Put_Line (" --target=targetname - specify a target for cross platforms"); Put_Line (" --RTS= - use runtime "); Put_Line (""); - Put_Line (" -h - print out the list of the available kp detectors"); - Put_Line (" -jn - n is the maximal number of processes"); - Put_Line (" -q - quiet mode (do not report detections in Stderr)"); - Put_Line (" -v - verbose mode"); - Put_Line (" -l - full pathname for file locations"); + Put_Line (" -h - print out the list of the available kp detectors"); + Put_Line (" -jn - n is the maximal number of processes"); + Put_Line (" -q - quiet mode (do not report detections in Stderr)"); + Put_Line (" -v - verbose mode"); + Put_Line (" -W, --warnings-as-errors - treat warning messages as errors"); + Put_Line (" -l - full pathname for file locations"); Put_Line (""); Put_Line (" --brief - brief mode, only report detections in Stderr"); Put_Line (" --check-semantic - check semantic validity of the source files"); @@ -636,18 +642,19 @@ package body Gnatcheck.Output is Put_Line (" --RTS= - use runtime "); Put_Line (" --config= - use configuration project "); Put_Line (""); - Put_Line (" -h - print out the list of the currently implemented rules"); - Put_Line (" -mn - n is the maximal number of diagnoses in Stderr"); - Put_Line (" (n in 0 .. 1000, 0 means no limit); default is 0"); - Put_Line (" -jn - n is the maximal number of processes"); - Put_Line (" -q - quiet mode (do not report detections in Stderr)"); - Put_Line (" -t - report execution time in Stderr"); - Put_Line (" -v - verbose mode"); - Put_Line (" -l - full pathname for file locations"); - Put_Line (" -log - duplicate all the messages sent to Stderr in gnatcheck.log"); - Put_Line (" -s - short form of the report file"); - Put_Line (" -xml - generate report in XML format"); - Put_Line (" -nt - do not generate text report (enforces '-xml')"); + Put_Line (" -h - print out the list of the currently implemented rules"); + Put_Line (" -mn - n is the maximal number of diagnoses in Stderr"); + Put_Line (" (n in 0 .. 1000, 0 means no limit); default is 0"); + Put_Line (" -jn - n is the maximal number of processes"); + Put_Line (" -q - quiet mode (do not report detections in Stderr)"); + Put_Line (" -t - report execution time in Stderr"); + Put_Line (" -v - verbose mode"); + Put_Line (" -W, --warnings-as-errors - treat warning messages as errors"); + Put_Line (" -l - full pathname for file locations"); + Put_Line (" -log - duplicate all the messages sent to Stderr in gnatcheck.log"); + Put_Line (" -s - short form of the report file"); + Put_Line (" -xml - generate report in XML format"); + Put_Line (" -nt - do not generate text report (enforces '-xml')"); Put_Line (""); Put_Line (" --show-rule - append rule names to diagnoses generated"); Put_Line (" --show-instantiation-chain - show instantiation chain for reported generic construct"); @@ -668,9 +675,9 @@ package body Gnatcheck.Output is Put_Line (" -ox filename - specify the name of the XML report file (enforces '-xml')"); Put_Line (""); Put_Line (" filename - the name of the Ada source file to be analyzed."); - Put_Line (" Wildcards are allowed"); + Put_Line (" Wildcards are allowed"); Put_Line (" -files=filename - the name of the text file containing a list of Ada"); - Put_Line (" source files to analyze"); + Put_Line (" source files to analyze"); Put_Line (" --ignore=filename - do not process sources listed in filename"); Put_Line (" --rule-file=filename - read rule configuration from the given LKQL file"); Put_Line (" -r, --rule [rule_name] - enable the given rule during the GNATcheck run (this option is cumulative)"); diff --git a/lkql_checker/src/gnatcheck-output.ads b/lkql_checker/src/gnatcheck-output.ads index 59ec6ec7b..98e9c86ef 100644 --- a/lkql_checker/src/gnatcheck-output.ads +++ b/lkql_checker/src/gnatcheck-output.ads @@ -18,6 +18,10 @@ package Gnatcheck.Output is Custom_XML_Report_File : Boolean := False; -- Undicate if custom name is specified for text or XML output file + Error_From_Warning : Boolean; + -- Whether a warning message has been emitted while "warnings as errors" + -- mode is enabled. This ensure the return code of GNATcheck is not 0. + procedure Print_Version_Info (Released_At : Positive); -- Prints into Stderr the tool version information in the following format: -- diff --git a/lkql_checker/src/gnatcheck_main.adb b/lkql_checker/src/gnatcheck_main.adb index 39e83c7d2..a67f12f31 100644 --- a/lkql_checker/src/gnatcheck_main.adb +++ b/lkql_checker/src/gnatcheck_main.adb @@ -604,22 +604,25 @@ begin Gnatcheck.Rules.Rule_Table.Clean_Up; Close_Log_File; - OS_Exit (if Tool_Failures /= 0 or else Detected_Internal_Error /= 0 - then E_Error - elsif Missing_Rule_File_Detected then E_Missing_Rule_File - elsif Bad_Rule_Detected then E_Missing_Rule - elsif Rule_Option_Problem_Detected then E_Bad_Rules - elsif Missing_File_Detected then E_Missing_Source - - -- If we are here, no problem with gnatcheck execution or rule - -- option or missing file definition is detected, so we can trust - -- gnatcheck results. - - elsif (Detected_Non_Exempted_Violations > 0 - or else Detected_Compiler_Error > 0) - and then not Arg.Brief_Mode - then E_Violation - else E_Success); + OS_Exit + (if Tool_Failures /= 0 + or else Detected_Internal_Error /= 0 + or else Error_From_Warning + then E_Error + elsif Missing_Rule_File_Detected then E_Missing_Rule_File + elsif Bad_Rule_Detected then E_Missing_Rule + elsif Rule_Option_Problem_Detected then E_Bad_Rules + elsif Missing_File_Detected then E_Missing_Source + + -- If we are here, no problem with gnatcheck execution or rule + -- option or missing file definition is detected, so we can trust + -- gnatcheck results. + + elsif (Detected_Non_Exempted_Violations > 0 + or else Detected_Compiler_Error > 0) + and then not Arg.Brief_Mode + then E_Violation + else E_Success); exception when Parameter_Error => diff --git a/testsuite/tests/gnatcheck/warnings_as_errors/main.adb b/testsuite/tests/gnatcheck/warnings_as_errors/main.adb new file mode 100644 index 000000000..15ca8dc46 --- /dev/null +++ b/testsuite/tests/gnatcheck/warnings_as_errors/main.adb @@ -0,0 +1,5 @@ +procedure Main is +begin + goto lbl; -- FLAG (2) + <> +end Main; diff --git a/testsuite/tests/gnatcheck/warnings_as_errors/rules.lkql b/testsuite/tests/gnatcheck/warnings_as_errors/rules.lkql new file mode 100644 index 000000000..1105716cb --- /dev/null +++ b/testsuite/tests/gnatcheck/warnings_as_errors/rules.lkql @@ -0,0 +1,4 @@ +val rules = @{ + goto_statements, + restrictions: {arg: ["No_Recursion"]} +} diff --git a/testsuite/tests/gnatcheck/warnings_as_errors/test.out b/testsuite/tests/gnatcheck/warnings_as_errors/test.out new file mode 100644 index 000000000..b87da7293 --- /dev/null +++ b/testsuite/tests/gnatcheck/warnings_as_errors/test.out @@ -0,0 +1,12 @@ +Without "warnings as errors" +============================ + +gnatcheck: restriction No_Recursion ignored (cannot be checked statically), use rule Recursive_Subprograms instead +main.adb:3:04: goto statement + +With "warnings as errors" +========================= + +gnatcheck: restriction No_Recursion ignored (cannot be checked statically), use rule Recursive_Subprograms instead +main.adb:3:04: goto statement +>>>program returned status code 2 diff --git a/testsuite/tests/gnatcheck/warnings_as_errors/test.yaml b/testsuite/tests/gnatcheck/warnings_as_errors/test.yaml new file mode 100644 index 000000000..32541be51 --- /dev/null +++ b/testsuite/tests/gnatcheck/warnings_as_errors/test.yaml @@ -0,0 +1,10 @@ +driver: gnatcheck +format: brief +input_sources: + - main.adb +lkql_rule_file: rules.lkql +tests: + - label: Without "warnings as errors" + - label: With "warnings as errors" + extra_args: + - -W From e2b082bbabbe7755b1091eb32b7553ce8c74aea3 Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Mon, 18 Nov 2024 11:43:54 +0100 Subject: [PATCH 8/8] Remove 'Warning_Mode' global because it is never wrote --- lkql_checker/src/gnatcheck-options.ads | 10 ---------- lkql_checker/src/gnatcheck-output.adb | 4 +--- lkql_checker/src/gnatcheck-output.ads | 2 +- 3 files changed, 2 insertions(+), 14 deletions(-) diff --git a/lkql_checker/src/gnatcheck-options.ads b/lkql_checker/src/gnatcheck-options.ads index b72763a47..608f7ad60 100644 --- a/lkql_checker/src/gnatcheck-options.ads +++ b/lkql_checker/src/gnatcheck-options.ads @@ -94,16 +94,6 @@ package Gnatcheck.Options is KP_Version : GNAT.OS_Lib.String_Access; -- If set, the relevant GNAT version to check when running gnatkp. - type Warning_Modes is - (Quiet, -- all warnings are suppressed - Short, - Normal, - Full); - - Warning_Mode : Warning_Modes := Normal; - -- Specifies the warning message level - -- '-w(q|s|n|f) - Log_Mode : Boolean := False; -- Create the log file and duplicate in this file all the messages -- generated by a tool. diff --git a/lkql_checker/src/gnatcheck-output.adb b/lkql_checker/src/gnatcheck-output.adb index 8a838c4f6..e034710d0 100644 --- a/lkql_checker/src/gnatcheck-output.adb +++ b/lkql_checker/src/gnatcheck-output.adb @@ -543,9 +543,7 @@ package body Gnatcheck.Output is procedure Warning (Message : String) is begin - if Arg.Warnings_As_Errors.Get or else Warning_Mode /= Quiet then - Error (Message); - end if; + Error (Message); -- Force a non-zero return code when "warnings as errors" is enabled if Arg.Warnings_As_Errors.Get then diff --git a/lkql_checker/src/gnatcheck-output.ads b/lkql_checker/src/gnatcheck-output.ads index 98e9c86ef..8e4e29a42 100644 --- a/lkql_checker/src/gnatcheck-output.ads +++ b/lkql_checker/src/gnatcheck-output.ads @@ -48,7 +48,7 @@ package Gnatcheck.Output is -- Sends into Stderr the error message with no tool name prefix procedure Warning (Message : String); - -- Same as Error, but do nothing if Warning_Mode = Quiet. + -- Same as ``Error`` procedure Info (Message : String); -- Sends Message into Stderr (with no tool name prefix).