From 7345e9733aff6a749ee1332d7c1ab8a1d9e6a909 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 20 Dec 2016 08:07:05 +0100 Subject: Add target in bug-box, add --bug-box internal command. --- src/ghdldrv/ghdllocal.adb | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) (limited to 'src/ghdldrv/ghdllocal.adb') diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 3a6910317..229108e5a 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -1065,6 +1065,37 @@ package body Ghdllocal is Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit); end Perform_Action; + -- Command --bug-box. + type Command_Bug_Box is new Command_Type with null record; + function Decode_Command (Cmd : Command_Bug_Box; Name : String) + return Boolean; + function Get_Short_Help (Cmd : Command_Bug_Box) return String; + procedure Perform_Action (Cmd : in out Command_Bug_Box; + Args : Argument_List); + + function Decode_Command (Cmd : Command_Bug_Box; Name : String) + return Boolean + is + pragma Unreferenced (Cmd); + begin + return Name = "--bug-box"; + end Decode_Command; + + function Get_Short_Help (Cmd : Command_Bug_Box) return String + is + pragma Unreferenced (Cmd); + begin + return "!--bug-box Crash and emit a bug-box"; + end Get_Short_Help; + + procedure Perform_Action (Cmd : in out Command_Bug_Box; + Args : Argument_List) + is + pragma Unreferenced (Cmd, Args); + begin + raise Program_Error; + end Perform_Action; + procedure Load_All_Libraries_And_Files is use Files_Map; @@ -1508,5 +1539,6 @@ package body Ghdllocal is Register_Command (new Command_Remove); Register_Command (new Command_Copy); Register_Command (new Command_Disp_Standard); + Register_Command (new Command_Bug_Box); end Register_Commands; end Ghdllocal; -- cgit v1.2.3