diff options
author | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2014-11-04 20:14:19 +0100 |
commit | 9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 (patch) | |
tree | 575346e529b99e26382b4a06f6ff2caa0b391ab2 /bug.adb | |
parent | 184a123f91e07c927292d67462561dc84f3a920d (diff) | |
download | ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.gz ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.bz2 ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.zip |
Move sources to src/ subdirectory.
Diffstat (limited to 'bug.adb')
-rw-r--r-- | bug.adb | 104 |
1 files changed, 0 insertions, 104 deletions
diff --git a/bug.adb b/bug.adb deleted file mode 100644 index 0948b97ff..000000000 --- a/bug.adb +++ /dev/null @@ -1,104 +0,0 @@ --- Bug handling --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Command_Line; use Ada.Command_Line; -with GNAT.Directory_Operations; -with Version; use Version; - -package body Bug is - -- Declared in the files generated by gnatbind. - -- Note: since the string is exported with C convension, there is no way - -- to know the length (gnat1 crashes if the string is unconstrained). - -- Hopefully, the format of the string seems to be fixed. - -- We don't use GNAT.Compiler_Version because it doesn't exist - -- in gnat 3.15p - GNAT_Version : constant String (1 .. 31 + 15); - pragma Import (C, GNAT_Version, "__gnat_version"); - - function Get_Gnat_Version return String - is - C : Character; - begin - for I in GNAT_Version'Range loop - C := GNAT_Version (I); - case C is - when ' ' - | 'A' .. 'Z' - | 'a' .. 'z' - | '0' .. '9' - | ':' - | '-' - | '.' - | '(' => - -- Accept only a few printable characters. - -- Underscore is excluded since the next bytes after - -- GNAT_Version is Ada_Main_Program_Name, which often starts - -- with _ada_. - null; - when ')' => - return GNAT_Version (1 .. I); - when others => - return GNAT_Version (1 .. I - 1); - end case; - end loop; - return GNAT_Version; - end Get_Gnat_Version; - - procedure Disp_Bug_Box (Except : Exception_Occurrence) - is - Id : Exception_Id; - begin - New_Line (Standard_Error); - Put_Line - (Standard_Error, - "******************** GHDL Bug occured ****************************"); - Put_Line - (Standard_Error, - "Please report this bug on http://gna.org/projects/ghdl"); - Put_Line (Standard_Error, "GHDL release: " & Ghdl_Release); - Put_Line (Standard_Error, "Compiled with " & Get_Gnat_Version); - Put_Line (Standard_Error, "In directory: " & - GNAT.Directory_Operations.Get_Current_Dir); - --Put_Line - -- ("Program name: " & Command_Name); - --Put_Line - -- ("Program arguments:"); - --for I in 1 .. Argument_Count loop - -- Put_Line (" " & Argument (I)); - --end loop; - Put_Line (Standard_Error, "Command line:"); - Put (Standard_Error, Command_Name); - for I in 1 .. Argument_Count loop - Put (Standard_Error, ' '); - Put (Standard_Error, Argument (I)); - end loop; - New_Line (Standard_Error); - Id := Exception_Identity (Except); - if Id /= Null_Id then - Put_Line (Standard_Error, - "Exception " & Exception_Name (Id) & " raised"); - --Put_Line ("exception message: " & Exception_Message (Except)); - Put_Line (Standard_Error, - "Exception information:"); - Put (Standard_Error, Exception_Information (Except)); - end if; - Put_Line - (Standard_Error, - "******************************************************************"); - end Disp_Bug_Box; -end Bug; |