diff options
| -rw-r--r-- | doc/Invoking_GHDL.rst | 38 | ||||
| -rw-r--r-- | src/flags.ads | 14 | ||||
| -rw-r--r-- | src/libraries.adb | 30 | ||||
| -rw-r--r-- | src/options.adb | 36 | ||||
| -rw-r--r-- | src/vhdl/errorout.adb | 149 | ||||
| -rw-r--r-- | src/vhdl/errorout.ads | 12 | ||||
| -rw-r--r-- | src/vhdl/sem.adb | 5 | ||||
| -rw-r--r-- | src/vhdl/sem_decls.adb | 14 | ||||
| -rw-r--r-- | src/vhdl/sem_names.adb | 3 |
9 files changed, 245 insertions, 56 deletions
diff --git a/doc/Invoking_GHDL.rst b/doc/Invoking_GHDL.rst index fb121ed22..f75345f2f 100644 --- a/doc/Invoking_GHDL.rst +++ b/doc/Invoking_GHDL.rst @@ -414,6 +414,9 @@ manual for details. :samp:`state1` are homograph, the enumeration literal is hidden in the immediate scope of the constant). + This option also relaxes the rules about pure functions. Violations + result in warnings instead of errors. + .. option:: -fpsl @@ -480,6 +483,7 @@ manual for details. Be verbose. For example, for analysis, elaboration and make commands, GHDL displays the commands executed. + Passing options to other programs ================================= @@ -507,6 +511,20 @@ GCC manual for details on GCC options. Pass `OPTION` as an option to the linker. +GHDL Diagnostics Control +======================== + +.. option:: -f[no-]color-diagnostics + + Control whether diagnostic messages are displayed in color. The + default is on when the standard output is a terminal. + +.. option:: -f[no-]diagnostics-show-option + + Control whether the warning option is displayed at the end of + warning messages, so that user can easily know how to disable it. + + GHDL warnings ============= @@ -514,8 +532,8 @@ Some constructions are not erroneous but dubious. Warnings are diagnostic messages that report such constructions. Some warnings are reported only during analysis, others during elaboration. -You could disable a warning by using the :samp:`--warn-no-XXX` -instead of :samp:`--warn-XXX`. +You could disable a warning by using the :samp:`--warn-no-XXX` or +:samp:`-Wno-XX` instead of :samp:`--warn-XXX` or :samp:`-WXXX`. .. option:: --warn-reserved @@ -592,6 +610,22 @@ instead of :samp:`--warn-XXX`. When this option is set, warnings are considered as errors. +.. option:: --warn-nested-comment + + Emit a warning if a :samp:`/*` appears within a block comment (vhdl 2008). + + +.. option:: --warn-parenthesis + + Emit a warning in case of weird use of parenthesis + + +.. option:: --warn-runtime-error + + Emit a warning in case of runtime error that is detected during + analysis. + + Rebuilding commands =================== diff --git a/src/flags.ads b/src/flags.ads index 1bb59c806..cdcdd0202 100644 --- a/src/flags.ads +++ b/src/flags.ads @@ -153,4 +153,18 @@ package Flags is -- --warn-error -- Turns warnings into errors. Warn_Error : Boolean := False; + + -- If True, disp original source line and a caret indicating the column. + Flag_Caret_Diagnostics : Boolean := False; + + type On_Off_Auto_Type is (On, Off, Auto); + + -- -fcolor-diagnostics + -- -fno-color-diagnostics + -- Enable colors in diagnostic messages. The default is auto, which turns + -- on when a terminal is detected on the standard error. + Flag_Color_Diagnostics : On_Off_Auto_Type := Auto; + + -- -fdiagnostics-show-option + Flag_Diagnostics_Show_Option : Boolean := True; end Flags; diff --git a/src/libraries.adb b/src/libraries.adb index 3f737f466..a49931071 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -63,12 +63,6 @@ package body Libraries is Report_Msg (Msgid_Error, Library, No_Location, Msg, (1 => Arg1)); end Error_Lib_Msg; - -- Report a warning message. - procedure Warning_Lib_Msg (Msg : String; Args : Earg_Arr := No_Eargs) is - begin - Report_Msg (Msgid_Warning, Library, No_Location, Msg, Args); - end Warning_Lib_Msg; - -- Initialize pathes table. -- Set the local path. procedure Init_Pathes @@ -190,11 +184,14 @@ package body Libraries is procedure Set_Work_Library_Path (Path : String) is begin Work_Directory := Path_To_Id (Path); - if not GNAT.OS_Lib.Is_Directory (Get_Address (Work_Directory)) then + if not GNAT.OS_Lib.Is_Directory (Get_Address (Work_Directory)) + and then Is_Warning_Enabled (Warnid_Library) + then -- This is a warning, since 'clean' action should not fail in -- this cases. - Warning_Lib_Msg - ("directory '" & Path & "' set by --workdir= does not exist"); + Warning_Msg_Option + (Warnid_Library, + "directory '" & Path & "' set by --workdir= does not exist"); -- raise Option_Error; end if; end Set_Work_Library_Path; @@ -1054,13 +1051,16 @@ package body Libraries is if Is_Warning_Enabled (Warnid_Library) then if Get_Kind (Library_Unit) /= Get_Kind (New_Library_Unit) then - Warning_Lib_Msg - ("changing definition of a library unit:"); - Warning_Lib_Msg - ("%n is now %n", (+Library_Unit, +New_Library_Unit)); + Warning_Msg_Sem + (Warnid_Library, +Unit, + "changing definition of a library unit:"); + Warning_Msg_Sem + (Warnid_Library, +Unit, + "%n is now %n", (+Library_Unit, +New_Library_Unit)); end if; - Warning_Lib_Msg - ("library unit %i was also defined in file %i", + Warning_Msg_Sem + (Warnid_Library, +Unit, + "library unit %i was also defined in file %i", (+Library_Unit, +Get_Design_File_Filename (Design_File))); end if; end if; diff --git a/src/options.adb b/src/options.adb index adfb605d4..e36e8bedd 100644 --- a/src/options.adb +++ b/src/options.adb @@ -106,9 +106,15 @@ package body Options is elsif Opt'Length > 10 and then Opt (1 .. 10) = "--workdir=" then Libraries.Set_Work_Library_Path (Opt (11 .. Opt'Last)); elsif Opt'Length > 10 and then Opt (1 .. 10) = "--warn-no-" then + -- Handle --warn-no before -warn-! return Option_Warning (Opt (11 .. Opt'Last), False); elsif Opt'Length > 7 and then Opt (1 .. 7) = "--warn-" then return Option_Warning (Opt (8 .. Opt'Last), True); + elsif Opt'Length > 5 and then Opt (1 .. 5) = "-Wno-" then + -- Handle -Wno before -W! + return Option_Warning (Opt (6 .. Opt'Last), False); + elsif Opt'Length > 2 and then Opt (1 .. 2) = "-W" then + return Option_Warning (Opt (3 .. Opt'Last), True); elsif Opt'Length > 7 and then Opt (1 .. 7) = "--work=" then declare use Name_Table; @@ -120,6 +126,18 @@ package body Options is end; elsif Opt = "-C" or else Opt = "--mb-comments" then Mb_Comment := True; + elsif Opt = "-fcaret-diagnostics" then + Flag_Caret_Diagnostics := True; + elsif Opt = "-fno-caret-diagnostics" then + Flag_Caret_Diagnostics := False; + elsif Opt = "-fcolor-diagnostics" then + Flag_Color_Diagnostics := On; + elsif Opt = "-fno-color-diagnostics" then + Flag_Color_Diagnostics := Off; + elsif Opt = "-fdiagnostics-show-option" then + Flag_Diagnostics_Show_Option := True; + elsif Opt = "-fno-diagnostics-show-option" then + Flag_Diagnostics_Show_Option := False; elsif Opt = "--bootstrap" then Bootstrap := True; elsif Opt = "-fexplicit" then @@ -212,15 +230,15 @@ package body Options is P (" --[no-]vital-checks do [not] check VITAL restrictions"); P ("Warnings:"); -- P (" --warn-undriven disp undriven signals"); - P (" --warn-binding warns for component not bound"); - P (" --warn-reserved warns use of 93 reserved words in vhdl87"); - P (" --warn-library warns for redefinition of a design unit"); - P (" --warn-vital-generic warns of non-vital generic names"); - P (" --warn-delayed-checks warns for checks performed at elaboration"); - P (" --warn-body warns for not necessary package body"); - P (" --warn-specs warns if a all/others spec does not apply"); - P (" --warn-unused warns if a subprogram is never used"); - P (" --warn-error turns warnings into errors"); + P (" -Wbinding warns for component not bound"); + P (" -Wreserved warns use of 93 reserved words in vhdl87"); + P (" -Wlibrary warns for redefinition of a design unit"); + P (" -Wvital-generic warns of non-vital generic names"); + P (" -Wdelayed-checks warns for checks performed at elaboration"); + P (" -Wbody warns for not necessary package body"); + P (" -Wspecs warns if a all/others spec does not apply"); + P (" -Wunused warns if a subprogram is never used"); + P (" -Werror turns warnings into errors"); -- P ("Simulation option:"); -- P (" --time-resolution=UNIT set the resolution of type time"); -- P (" UNIT can be fs, ps, ns, us, ms, sec, min or hr"); diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index 60e77871a..a0b279752 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -22,16 +22,69 @@ with Iirs_Utils; use Iirs_Utils; with Files_Map; use Files_Map; with Ada.Strings.Unbounded; with Std_Names; -with Flags; +with Flags; use Flags; with PSL.Nodes; package body Errorout is - -- If True, disp original source line and a caret indicating the column. - Flag_Show_Caret : constant Boolean := False; - -- Name of the program, used to report error message. Program_Name : String_Acc := null; + -- Terminal. + + -- Set Flag_Color_Diagnostics to On or Off if is was Auto. + procedure Detect_Terminal + is + function isatty (Fd : Integer) return Integer; + pragma Import (C, isatty); + begin + if Flag_Color_Diagnostics = Auto then + if isatty (2) /= 0 then + Flag_Color_Diagnostics := On; + else + Flag_Color_Diagnostics := Off; + end if; + end if; + end Detect_Terminal; + + -- Color to be used for various part of messages. + type Color_Type is (Color_Locus, + Color_Note, Color_Warning, Color_Error, Color_Fatal, + Color_Message, + Color_None); + + -- Switch to COLOR. + procedure Set_Color (Color : Color_Type) + is + procedure Put (S : String) + is + use Ada.Text_IO; + begin + Put (Standard_Error, S); + end Put; + begin + if Flag_Color_Diagnostics = Off then + return; + end if; + + -- Use ANSI sequences. + -- They are also documented on msdn in 'Console Virtual Terminal + -- sequences'. + + Put (ASCII.ESC & '['); + case Color is + when Color_Locus => Put ("1"); -- Bold + when Color_Note => Put ("1;36"); -- Bold, cyan + when Color_Warning => Put ("1;35"); -- Bold, magenta + when Color_Error => Put ("1;31"); -- Bold, red + when Color_Fatal => Put ("1;33"); -- Bold, yellow + when Color_Message => Put ("0;1"); -- Normal, bold + when Color_None => Put ("0"); -- Normal + end case; + Put ("m"); + end Set_Color; + + -- Warnings. + type Warning_Control_Type is record Enabled : Boolean; Error : Boolean; @@ -40,8 +93,11 @@ package body Errorout is type Warnings_Array is array (Msgid_Warnings) of Warning_Control_Type; Warnings_Control : Warnings_Array := - (Warnid_Binding => (Enabled => True, Error => False), - others => (Enabled => False, Error => False)); + (Warnid_Binding + | Warnid_Library => (Enabled => True, Error => False), + Warnid_Shared + | Warnid_Pure => (Enabled => True, Error => False), + others => (Enabled => False, Error => False)); procedure Enable_Warning (Id : Msgid_Warnings; Enable : Boolean) is begin @@ -56,12 +112,15 @@ package body Errorout is function Warning_Image (Id : Msgid_Warnings) return String is Img : constant String := Msgid_Warnings'Image (Id); + + -- Prefix to strip. Prefix : constant String := "WARNID_"; pragma Assert (Img'Length > Prefix'Length); pragma Assert (Img (1 .. Prefix'Length) = Prefix); Res : String (1 .. Img'Last - Prefix'Length); C : Character; begin + -- Convert to lower cases, and '_' to '-'. for I in Res'Range loop C := Img (Prefix'Length + I); case C is @@ -74,6 +133,7 @@ package body Errorout is end case; Res (I) := C; end loop; + return Res; end Warning_Image; @@ -142,7 +202,7 @@ package body Errorout is Put (Standard_Error, C); end Put; - procedure Put_Line (Str : String) + procedure Put_Line (Str : String := "") is use Ada.Text_IO; begin @@ -183,7 +243,11 @@ package body Errorout is procedure Disp_Location (File: Name_Id; Line: Natural; Col: Natural) is begin - Put (Name_Table.Image (File)); + if File = Null_Identifier then + Put ("??"); + else + Put (Name_Table.Image (File)); + end if; Put (':'); Disp_Natural (Line); Put (':'); @@ -238,6 +302,8 @@ package body Errorout is -- And no program name. Progname := False; + Detect_Terminal; + case Origin is when Option | Library => @@ -276,12 +342,16 @@ package body Errorout is Msg_Len := 0; + if Flag_Color_Diagnostics = On then + Set_Color (Color_Locus); + end if; + if Progname then Disp_Program_Name; elsif File /= No_Source_File_Entry then Disp_Location (Get_File_Name (File), Line, Col); else - Put ("??:??:??:"); + Disp_Location (Null_Identifier, 0, 0); end if; -- Display level. @@ -298,20 +368,38 @@ package body Errorout is case Id_Level is when Msgid_Note => + if Flag_Color_Diagnostics = On then + Set_Color (Color_Note); + end if; Put ("note:"); when Msgid_Warning | Msgid_Warnings => + if Flag_Color_Diagnostics = On then + Set_Color (Color_Warning); + end if; Put ("warning:"); when Msgid_Error => Nbr_Errors := Nbr_Errors + 1; - if Msg_Len = 0 then - -- 'error:' is displayed only if not location is present. + if Flag_Color_Diagnostics = On then + Set_Color (Color_Error); + end if; + if Msg_Len = 0 + or else Flag_Color_Diagnostics = On + then + -- 'error:' is displayed only if not location is present, or + -- if messages are colored. Put ("error:"); end if; when Msgid_Fatal => + if Flag_Color_Diagnostics = On then + Set_Color (Color_Fatal); + end if; Put ("fatal:"); end case; end; + if Flag_Color_Diagnostics = On then + Set_Color (Color_Message); + end if; Put (' '); -- Display message. @@ -442,13 +530,27 @@ package body Errorout is end if; N := N + 1; end loop; - Put_Line (Msg (First .. N - 1)); + Put (Msg (First .. N - 1)); -- Are all arguments displayed ? pragma Assert (Argn > Args'Last); end; - if Flag_Show_Caret + if Flag_Diagnostics_Show_Option + and then Id in Msgid_Warnings + then + Put (" [-W"); + Put (Warning_Image (Id)); + Put ("]"); + end if; + + if Flag_Color_Diagnostics = On then + Set_Color (Color_None); + end if; + + Put_Line; + + if Flag_Caret_Diagnostics and then (File /= No_Source_File_Entry and Line /= 0) then declare @@ -481,6 +583,11 @@ package body Errorout is raise Option_Error; end Error_Msg_Option; + procedure Warning_Msg_Option (Id : Msgid_Warnings; Msg: String) is + begin + Report_Msg (Id, Option, No_Location, Msg); + end Warning_Msg_Option; + procedure Warning_Msg_Sem (Id : Msgid_Warnings; Loc : Location_Type; Msg: String; @@ -598,15 +705,18 @@ package body Errorout is end Error_Msg_Sem_1; procedure Error_Msg_Relaxed (Origin : Report_Origin; + Id : Msgid_Warnings; Msg : String; Loc : Iir; Args : Earg_Arr := No_Eargs) is - use Flags; Level : Msgid_Type; begin if Flag_Relaxed_Rules or Vhdl_Std = Vhdl_93c then - Level := Msgid_Warning; + if not Is_Warning_Enabled (Id) then + return; + end if; + Level := Id; else Level := Msgid_Error; end if; @@ -614,10 +724,11 @@ package body Errorout is end Error_Msg_Relaxed; procedure Error_Msg_Sem_Relaxed (Loc : Iir; + Id : Msgid_Warnings; Msg : String; Args : Earg_Arr := No_Eargs) is begin - Error_Msg_Relaxed (Semantic, Msg, Loc, Args); + Error_Msg_Relaxed (Semantic, Id, Msg, Loc, Args); end Error_Msg_Sem_Relaxed; -- Disp a message during elaboration. @@ -1425,10 +1536,12 @@ package body Errorout is L := Loc; end if; Error_Msg_Relaxed - (Origin, "pure " & Disp_Node (Caller) & " cannot call (impure) " + (Origin, Warnid_Pure, + "pure " & Disp_Node (Caller) & " cannot call (impure) " & Disp_Node (Callee), L); Error_Msg_Relaxed - (Origin, "(" & Disp_Node (Callee) & " is defined here)", Callee); + (Origin, Warnid_Pure, + "(" & Disp_Node (Callee) & " is defined here)", Callee); end Error_Pure; procedure Error_Not_Match (Expr: Iir; A_Type: Iir) diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads index 793c7a36f..417ea9077 100644 --- a/src/vhdl/errorout.ads +++ b/src/vhdl/errorout.ads @@ -94,10 +94,16 @@ package Errorout is -- Signal assignment creates a delta cycle in a postponed process. Warnid_Delta_Cycle, + -- Declaration of a shared variable with a non-protected type. + Warnid_Shared, + -- Emit a warning when a declaration is never used. -- FIXME: currently only subprograms are handled. Warnid_Unused, + -- Violation of pure rules. + Warnid_Pure, + -- Any error Msgid_Error, @@ -106,7 +112,7 @@ package Errorout is -- All specific warning messages. subtype Msgid_Warnings is Msgid_Type - range Warnid_Library .. Warnid_Unused; + range Warnid_Library .. Warnid_Pure; -- Get the image of a warning. This correspond the the identifier of ID, -- in lower case, without the Msgid_Warn_ prefix and with '_' replaced @@ -166,6 +172,9 @@ package Errorout is -- Same as Error_Msg_Option but do not raise Option_Error. procedure Error_Msg_Option_NR (Msg: String); + -- Warn about an option. + procedure Warning_Msg_Option (Id : Msgid_Warnings; Msg: String); + -- Disp a message during scan. -- The current location is automatically displayed before the message. procedure Error_Msg_Scan (Msg: String); @@ -208,6 +217,7 @@ package Errorout is -- Like Error_Msg_Sem, but a warning if -frelaxed or --std=93c. procedure Error_Msg_Sem_Relaxed (Loc : Iir; + Id : Msgid_Warnings; Msg : String; Args : Earg_Arr := No_Eargs); diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index a213ceee2..24c991a45 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -1879,7 +1879,7 @@ package body Sem is and then Get_Pure_Flag (Subprg) then Error_Msg_Sem_Relaxed - (Subprg, + (Subprg, Warnid_Pure, "result subtype of a pure function cannot denote an" & " access type"); end if; @@ -1889,7 +1889,8 @@ package body Sem is and then Get_Pure_Flag (Subprg) then Error_Msg_Sem_Relaxed - (Subprg, "result subtype of a pure function cannot have" + (Subprg, Warnid_Pure, + "result subtype of a pure function cannot have" & " access subelements"); end if; end case; diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb index d39d0a978..122bcf17e 100644 --- a/src/vhdl/sem_decls.adb +++ b/src/vhdl/sem_decls.adb @@ -1938,19 +1938,16 @@ package body Sem_Decls is -- parse. if Flags.Vhdl_Std >= Vhdl_00 then declare - Base_Type : Iir; - Is_Protected : Boolean; - begin - Base_Type := Get_Base_Type (Atype); - Is_Protected := + Base_Type : constant Iir := Get_Base_Type (Atype); + Is_Protected : constant Boolean := Get_Kind (Base_Type) = Iir_Kind_Protected_Type_Declaration; - + begin -- LRM00 4.3.1.3 -- The base type of the subtype indication of a -- shared variable declaration must be a protected type. if Get_Shared_Flag (Decl) and not Is_Protected then Error_Msg_Sem_Relaxed - (Decl, + (Decl, Warnid_Shared, "type of a shared variable must be a protected type"); end if; @@ -2099,7 +2096,8 @@ package body Sem_Decls is Spec := Get_Subprogram_Specification (Parent); if Get_Pure_Flag (Spec) then Error_Msg_Sem_Relaxed - (Decl, "cannot declare a file in a pure function"); + (Decl, Warnid_Pure, + "cannot declare a file in a pure function"); end if; when Iir_Kind_Procedure_Body => Spec := Get_Subprogram_Specification (Parent); diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb index ad82e329f..ca882c8db 100644 --- a/src/vhdl/sem_names.adb +++ b/src/vhdl/sem_names.adb @@ -1366,7 +1366,8 @@ package body Sem_Names is is begin Error_Msg_Sem_Relaxed - (Loc, "reference to %n violate pure rule for %n", (+Obj, +Subprg)); + (Loc, Warnid_Pure, + "reference to %n violate pure rule for %n", (+Obj, +Subprg)); end Error_Pure; Subprg : constant Iir := Sem_Stmts.Get_Current_Subprogram; |