-- --
-- B o d y --
-- --
--- $Revision: 1.57 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package body Comperr is
+ ----------------
+ -- Local Data --
+ ----------------
+
+ Abort_In_Progress : Boolean := False;
+ -- Used to prevent runaway recursion if something segfaults
+ -- while processing a previous abort.
+
-----------------------
-- Local Subprograms --
-----------------------
(X : String;
Code : Integer := 0)
is
+ -- The procedures below output a "bug box" with information about
+ -- the cause of the compiler abort and about the preferred method
+ -- of reporting bugs. The default is a bug box appropriate for
+ -- the FSF version of GNAT, but there are specializations for
+ -- the GNATPRO and Public releases by Ada Core Technologies.
+
procedure End_Line;
-- Add blanks up to column 76, and then a final vertical bar
+ --------------
+ -- End_Line --
+ --------------
+
procedure End_Line is
begin
Repeat_Char (' ', 76, '|');
Write_Eol;
end End_Line;
- Public_Version : constant Boolean := (Gnat_Version_String (5) = 'p');
+ Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
+ Is_FSF_Version : constant Boolean := Get_Gnat_Build_Type = FSF;
+ Is_GAP_Version : constant Boolean := Get_Gnat_Build_Type = GAP;
-- Start of processing for Compiler_Abort
begin
- -- If errors have already occured, then we guess that the abort may
- -- well be caused by previous errors, and we don't make too much fuss
- -- about it, since we want to let the programmer fix the errors first.
+ -- Prevent recursion through Compiler_Abort, e.g. via SIGSEGV.
+
+ if Abort_In_Progress then
+ Exit_Program (E_Abort);
+ end if;
+
+ Abort_In_Progress := True;
+
+ -- If any errors have already occurred, then we guess that the abort
+ -- may well be caused by previous errors, and we don't make too much
+ -- fuss about it, since we want to let programmer fix the errors first.
-- Debug flag K disables this behavior (useful for debugging)
- if Errors_Detected /= 0 and then not Debug_Flag_K then
+ if Serious_Errors_Detected /= 0 and then not Debug_Flag_K then
Errout.Finalize;
Set_Standard_Error;
-- Otherwise we use the standard fixed text
else
- Write_Str
- ("| Please submit bug report by email to report@gnat.com.");
- End_Line;
+ if Is_FSF_Version then
+ Write_Str
+ ("| Please submit a bug report; see" &
+ " http://gcc.gnu.org/bugs.html.");
+ End_Line;
+
+ else
+ Write_Str
+ ("| Please submit bug report by email " &
+ "to report@gnat.com.");
+ End_Line;
- if not Public_Version then
Write_Str
("| Use a subject line meaningful to you" &
" and us to track the bug.");
End_Line;
+ end if;
+ if not (Is_Public_Version or Is_FSF_Version) then
Write_Str
("| (include your customer number #nnn " &
"in the subject line).");
("| (concatenated together with no headers between files).");
End_Line;
- if Public_Version then
+ if Is_Public_Version then
Write_Str
("| (use plain ASCII or MIME attachment).");
End_Line;
"for submitting bugs.");
End_Line;
- else
+ elsif Is_GAP_Version then
+ Write_Str
+ ("| (use plain ASCII or MIME attachment, or FTP "
+ & "to your GAP account.).");
+ End_Line;
+
+ Write_Str
+ ("| Please use your GAP account to report this.");
+ End_Line;
+
+ elsif not Is_FSF_Version then
Write_Str
("| (use plain ASCII or MIME attachment, or FTP "
& "to your customer directory).");
Write_Eol;
Write_Line ("Please include these source files with error report");
+ Write_Line ("Note that list may not be accurate in some cases, ");
+ Write_Line ("so please double check that the problem can still ");
+ Write_Line ("be reproduced with the set of files listed.");
Write_Eol;
for U in Main_Unit .. Last_Unit loop
OSDN Git Service
