diff options
| -rw-r--r-- | src/errorout.adb | 57 | ||||
| -rw-r--r-- | src/errorout.ads | 17 |
2 files changed, 41 insertions, 33 deletions
diff --git a/src/errorout.adb b/src/errorout.adb index 55ac6c814..d1bec4cbf 100644 --- a/src/errorout.adb +++ b/src/errorout.adb @@ -148,6 +148,22 @@ package body Errorout is return Res; end "+"; + procedure Report_Vhdl_Token (Tok : Vhdl.Tokens.Token_Type) + is + use Vhdl.Tokens; + begin + case Tok is + when Tok_Identifier => + Report_Handler.Message ("an identifier"); + when Tok_Eof => + Report_Handler.Message ("end of file"); + when others => + Report_Handler.Message ("'"); + Report_Handler.Message (Image (Tok)); + Report_Handler.Message ("'"); + end case; + end Report_Vhdl_Token; + procedure Report_Msg (Id : Msgid_Type; Origin : Report_Origin; Loc : Source_Coord_Type; @@ -236,8 +252,9 @@ package body Errorout is begin Report_Handler.Message (""""); case Arg.Kind is - when Earg_Iir => - Id := Get_Identifier (Arg.Val_Iir); + when Earg_Vhdl_Node => + Id := Vhdl.Nodes.Get_Identifier + (Arg.Val_Vhdl_Node); when Earg_Id => Id := Arg.Val_Id; when others => @@ -265,27 +282,15 @@ package body Errorout is when 't' => -- A token declare - use Vhdl.Tokens; Arg : Earg_Type renames Args (Argn); - Tok : Token_Type; begin case Arg.Kind is - when Earg_Token => - Tok := Arg.Val_Tok; + when Earg_Vhdl_Token => + Report_Vhdl_Token (Arg.Val_Vhdl_Tok); when others => -- Invalid conversion to character. raise Internal_Error; end case; - case Tok is - when Tok_Identifier => - Report_Handler.Message ("an identifier"); - when Tok_Eof => - Report_Handler.Message ("end of file"); - when others => - Report_Handler.Message ("'"); - Report_Handler.Message (Image (Tok)); - Report_Handler.Message ("'"); - end case; end; when 'l' => -- Location @@ -299,8 +304,9 @@ package body Errorout is case Arg.Kind is when Earg_Location => Arg_Loc := Arg.Val_Loc; - when Earg_Iir => - Arg_Loc := Get_Location (Arg.Val_Iir); + when Earg_Vhdl_Node => + Arg_Loc := Vhdl.Nodes.Get_Location + (Arg.Val_Vhdl_Node); when others => raise Internal_Error; end case; @@ -326,8 +332,9 @@ package body Errorout is Arg : Earg_Type renames Args (Argn); begin case Arg.Kind is - when Earg_Iir => - Report_Handler.Message (Disp_Node (Arg.Val_Iir)); + when Earg_Vhdl_Node => + Report_Handler.Message + (Disp_Node (Arg.Val_Vhdl_Node)); when others => -- Invalid conversion to node. raise Internal_Error; @@ -386,9 +393,9 @@ package body Errorout is Report_Msg (Msgid_Error, Option, No_Source_Coord, Msg); end Error_Msg_Option_NR; - procedure Error_Msg_Option (Msg: String) is + procedure Error_Msg_Option (Msg: String; Args : Earg_Arr := No_Eargs) is begin - Error_Msg_Option_NR (Msg); + Report_Msg (Msgid_Error, Option, No_Source_Coord, Msg, Args); raise Option_Error; end Error_Msg_Option; @@ -397,14 +404,14 @@ package body Errorout is Report_Msg (Id, Option, No_Source_Coord, Msg); end Warning_Msg_Option; - function Make_Earg_Vhdl_Node (V : Iir) return Earg_Type is + function Make_Earg_Vhdl_Node (V : Vhdl.Nodes.Iir) return Earg_Type is begin - return (Kind => Earg_Iir, Val_Iir => V); + return (Kind => Earg_Vhdl_Node, Val_Vhdl_Node => V); end Make_Earg_Vhdl_Node; function Make_Earg_Vhdl_Token (V : Vhdl.Tokens.Token_Type) return Earg_Type is begin - return (Kind => Earg_Token, Val_Tok => V); + return (Kind => Earg_Vhdl_Token, Val_Vhdl_Tok => V); end Make_Earg_Vhdl_Token; end Errorout; diff --git a/src/errorout.ads b/src/errorout.ads index 88b82b18a..860e663ba 100644 --- a/src/errorout.ads +++ b/src/errorout.ads @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Types; use Types; -with Vhdl.Nodes; use Vhdl.Nodes; +with Vhdl.Nodes; with Vhdl.Tokens; package Errorout is @@ -226,7 +226,7 @@ package Errorout is -- Disp an error, prepended with program name, and raise option_error. -- This is used for errors before initialisation, such as bad option or -- bad filename. - procedure Error_Msg_Option (Msg: String); + procedure Error_Msg_Option (Msg: String; Args : Earg_Arr := No_Eargs); pragma No_Return (Error_Msg_Option); -- Same as Error_Msg_Option but do not raise Option_Error. @@ -235,29 +235,30 @@ package Errorout is -- Warn about an option. procedure Warning_Msg_Option (Id : Msgid_Warnings; Msg: String); - function Make_Earg_Vhdl_Node (V : Iir) return Earg_Type; + function Make_Earg_Vhdl_Node (V : Vhdl.Nodes.Iir) return Earg_Type; function Make_Earg_Vhdl_Token (V : Vhdl.Tokens.Token_Type) return Earg_Type; private type Earg_Kind is (Earg_None, - Earg_Iir, Earg_Location, Earg_Id, Earg_Char, Earg_Token, Earg_String8); + Earg_Location, Earg_Id, Earg_Char, Earg_String8, + Earg_Vhdl_Node, Earg_Vhdl_Token); type Earg_Type (Kind : Earg_Kind := Earg_None) is record case Kind is when Earg_None => null; - when Earg_Iir => - Val_Iir : Iir; when Earg_Location => Val_Loc : Location_Type; when Earg_Id => Val_Id : Name_Id; when Earg_Char => Val_Char : Character; - when Earg_Token => - Val_Tok : Vhdl.Tokens.Token_Type; when Earg_String8 => Val_Str8 : String8_Len_Type; + when Earg_Vhdl_Node => + Val_Vhdl_Node : Vhdl.Nodes.Iir; + when Earg_Vhdl_Token => + Val_Vhdl_Tok : Vhdl.Tokens.Token_Type; end case; end record; |