diff options
| -rw-r--r-- | src/ghdldrv/ghdlmain.adb | 18 | ||||
| -rw-r--r-- | src/vhdl/errorout.adb | 61 | ||||
| -rw-r--r-- | src/vhdl/errorout.ads | 4 |
3 files changed, 57 insertions, 26 deletions
diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb index 8c4267602..2f1d37e8d 100644 --- a/src/ghdldrv/ghdlmain.adb +++ b/src/ghdldrv/ghdlmain.adb @@ -21,6 +21,7 @@ with Ada.Command_Line.Response_File; with Version; with Bug; with Options; +with Types; use Types; package body Ghdlmain is procedure Init (Cmd : in out Command_Type) @@ -239,22 +240,16 @@ package body Ghdlmain is -- Disp MSG on the standard output with the command name. procedure Error (Msg : String) is - use Ada.Command_Line; - use Ada.Text_IO; + use Errorout; begin - Put (Standard_Error, Command_Name); - Put (Standard_Error, ": "); - Put_Line (Standard_Error, Msg); + Report_Msg (Msgid_Error, Option, No_Location, Msg); end Error; procedure Warning (Msg : String) is - use Ada.Command_Line; - use Ada.Text_IO; + use Errorout; begin - Put (Standard_Error, Command_Name); - Put (Standard_Error, ":warning: "); - Put_Line (Standard_Error, Msg); + Report_Msg (Msgid_Warning, Option, No_Location, Msg); end Warning; procedure Main @@ -266,6 +261,9 @@ package body Ghdlmain is Arg_Index : Natural; First_Arg : Natural; begin + -- Set program name for error message. + Errorout.Set_Program_Name (Command_Name); + -- Handle case of no argument if Argument_Count = 0 then Error ("missing command, try " & Command_Name & " --help"); diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb index c5c5d9b1f..00a737c44 100644 --- a/src/vhdl/errorout.adb +++ b/src/vhdl/errorout.adb @@ -16,7 +16,6 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; -with Ada.Command_Line; with Scanner; with Name_Table; with Iirs_Utils; use Iirs_Utils; @@ -30,6 +29,9 @@ 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; + type Warning_Control_Type is record Enabled : Boolean; Error : Boolean; @@ -122,10 +124,13 @@ package body Errorout is end if; end "+"; + Msg_Len : Natural; + procedure Put (Str : String) is use Ada.Text_IO; begin + Msg_Len := Msg_Len + Str'Length; Put (Standard_Error, Str); end Put; @@ -133,6 +138,7 @@ package body Errorout is is use Ada.Text_IO; begin + Msg_Len := Msg_Len + 1; Put (Standard_Error, C); end Put; @@ -141,6 +147,7 @@ package body Errorout is use Ada.Text_IO; begin Put_Line (Standard_Error, Str); + Msg_Len := 0; end Put_Line; procedure Disp_Natural (Val: Natural) @@ -184,10 +191,17 @@ package body Errorout is Put (':'); end Disp_Location; + procedure Set_Program_Name (Name : String) is + begin + Program_Name := new String'(Name); + end Set_Program_Name; + procedure Disp_Program_Name is begin - Put (Ada.Command_Line.Command_Name); - Put (':'); + if Program_Name /= null then + Put (Program_Name.all); + Put (':'); + end if; end Disp_Program_Name; procedure Report_Msg (Id : Msgid_Type; @@ -260,6 +274,8 @@ package body Errorout is end if; end case; + Msg_Len := 0; + if Progname then Disp_Program_Name; elsif File /= No_Source_File_Entry then @@ -268,20 +284,33 @@ package body Errorout is Put ("??:??:??:"); end if; - case Id is - when Msgid_Note => - Put ("note:"); - when Msgid_Warning | Msgid_Warnings => - if Flags.Warn_Error then - Nbr_Errors := Nbr_Errors + 1; - else + -- Display level. + declare + Id_Level : Msgid_Type; + begin + if Flags.Warn_Error + and then (Id = Msgid_Warning or Id in Msgid_Warnings) + then + Id_Level := Msgid_Error; + else + Id_Level := Id; + end if; + + case Id_Level is + when Msgid_Note => + Put ("note:"); + when Msgid_Warning | Msgid_Warnings => Put ("warning:"); - end if; - when Msgid_Error => - Nbr_Errors := Nbr_Errors + 1; - when Msgid_Fatal => - Put ("fatal:"); - end case; + when Msgid_Error => + Nbr_Errors := Nbr_Errors + 1; + if Msg_Len = 0 then + -- 'error:' is displayed only if not location is present. + Put ("error:"); + end if; + when Msgid_Fatal => + Put ("fatal:"); + end case; + end; Put (' '); diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads index 4b1ed23ee..793c7a36f 100644 --- a/src/vhdl/errorout.ads +++ b/src/vhdl/errorout.ads @@ -24,6 +24,10 @@ package Errorout is Parse_Error: exception; Compilation_Error: exception; + -- Set the program name, used in error messages for options. Not displayed + -- if not initialized. + procedure Set_Program_Name (Name : String); + -- This kind can't be handled. --procedure Error_Kind (Msg: String; Kind: Iir_Kind); procedure Error_Kind (Msg: String; An_Iir: in Iir); |