OSDN Git Service

2007-04-20 Vincent Celier <celier@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / comperr.adb
index 1725890..9b89852 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2006, 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- --
 -- 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  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
--- MA 02111-1307, USA.                                                      --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
+-- Extensive contributions were provided by AdaCore.                         --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -71,14 +71,18 @@ package body Comperr is
    --------------------
 
    procedure Compiler_Abort
-     (X    : String;
-      Code : Integer := 0)
+     (X            : String;
+      Code         : Integer := 0;
+      Fallback_Loc : String := "")
    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.
+      --  the GNATPRO and Public releases by AdaCore.
+
+      XF : constant Positive := X'First;
+      --  Start index, usually 1, but we won't assume this
 
       procedure End_Line;
       --  Add blanks up to column 76, and then a final vertical bar
@@ -93,14 +97,15 @@ package body Comperr is
          Write_Eol;
       end End_Line;
 
-      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;
+      Is_GPL_Version : constant Boolean := Gnatvsn.Build_Type = GPL;
+      Is_FSF_Version : constant Boolean := Gnatvsn.Build_Type = FSF;
 
    --  Start of processing for Compiler_Abort
 
    begin
-      --  Prevent recursion through Compiler_Abort, e.g. via SIGSEGV.
+      Cancel_Special_Output;
+
+      --  Prevent recursion through Compiler_Abort, e.g. via SIGSEGV
 
       if Abort_In_Progress then
          Exit_Program (E_Abort);
@@ -116,6 +121,7 @@ package body Comperr is
 
       if Serious_Errors_Detected /= 0 and then not Debug_Flag_K then
          Errout.Finalize;
+         Errout.Output_Messages;
 
          Set_Standard_Error;
          Write_Str ("compilation abandoned due to previous error");
@@ -174,16 +180,16 @@ package body Comperr is
                Last_Blank : Integer := 70;
 
             begin
-               for P in 40 .. 69 loop
-                  if X (P) = ' ' then
+               for P in 39 .. 68 loop
+                  if X (XF + P) = ' ' then
                      Last_Blank := P;
                   end if;
                end loop;
 
-               Write_Str (X (1 .. Last_Blank));
+               Write_Str (X (XF .. XF - 1 + Last_Blank));
                End_Line;
                Write_Str ("|    ");
-               Write_Str (X (Last_Blank + 1 .. X'Length));
+               Write_Str (X (XF + Last_Blank .. X'Last));
             end;
          else
             Write_Str (X);
@@ -209,10 +215,14 @@ package body Comperr is
 
          --  Output source location information
 
-         if Sloc (Current_Error_Node) <= Standard_Location
-           or else Sloc (Current_Error_Node) = No_Location
-         then
-            Write_Str ("| No source file position information available");
+         if Sloc (Current_Error_Node) <= No_Location then
+            if Fallback_Loc'Length > 0 then
+               Write_Str ("| Error detected around ");
+               Write_Str (Fallback_Loc);
+            else
+               Write_Str ("| No source file position information available");
+            end if;
+
             End_Line;
          else
             Write_Str ("| Error detected at ");
@@ -268,26 +278,54 @@ package body Comperr is
                      " http://gcc.gnu.org/bugs.html.");
                   End_Line;
 
+               elsif Is_GPL_Version then
+
+                  Write_Str
+                    ("| Please submit a bug report by email " &
+                     "to report@adacore.com.");
+                  End_Line;
+
+                  Write_Str
+                    ("| GAP members can alternatively use GNAT Tracker:");
+                  End_Line;
+
+                  Write_Str
+                    ("| http://www.adacore.com/ " &
+                     "section 'send a report'.");
+                  End_Line;
+
+                  Write_Str
+                    ("| See gnatinfo.txt for full info on procedure " &
+                     "for submitting bugs.");
+                  End_Line;
+
                else
                   Write_Str
-                    ("| Please submit bug report by email " &
-                     "to report@gnat.com.");
+                    ("| Please submit a bug report using GNAT Tracker:");
                   End_Line;
 
                   Write_Str
-                    ("| Use a subject line meaningful to you" &
-                     " and us to track the bug.");
+                    ("| http://www.adacore.com/gnattracker/ " &
+                     "section 'send a report'.");
+                  End_Line;
+
+                  Write_Str
+                    ("| alternatively submit a bug report by email " &
+                     "to report@adacore.com,");
                   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).");
+                    ("| including your customer number #nnn " &
+                     "in the subject line.");
                   End_Line;
                end if;
 
                Write_Str
+                 ("| Use a subject line meaningful to you" &
+                  " and us to track the bug.");
+               End_Line;
+
+               Write_Str
                  ("| Include the entire contents of this bug " &
                   "box in the report.");
                End_Line;
@@ -305,35 +343,9 @@ package body Comperr is
                  ("| (concatenated together with no headers between files).");
                End_Line;
 
-               if Is_Public_Version then
-                  Write_Str
-                    ("| (use plain ASCII or MIME attachment).");
-                  End_Line;
-
+               if not Is_FSF_Version then
                   Write_Str
-                    ("| See gnatinfo.txt for full info on procedure " &
-                     "for submitting bugs.");
-                  End_Line;
-
-               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).");
-                  End_Line;
-
-                  Write_Str
-                    ("| See README.GNATPRO for full info on procedure " &
-                     "for submitting bugs.");
+                    ("| Use plain ASCII or MIME attachment.");
                   End_Line;
                end if;
             end if;