comperr.adb (Compiler_Abort): New Finalize/Output_Messages interface for Errout

2007-04-20  Robert Dewar  <dewar@adacore.com>

	* comperr.adb (Compiler_Abort): New Finalize/Output_Messages interface
	for Errout

	* errout.adb: New Finalize/Compilation_Errors/Output_Messages
	implementation

	* errout.ads (Finalize): Changed interface
	(Output_Messages): New procedure
	(Compilation_Errors): New Interface

	* prepcomp.ads, prepcomp.adb (Parse_Preprocessing_Data_File): New
	Finalize/Output_Messages interface for Errout
	(Prepare_To_Preprocess): New Finalize/Output_Messages interface for
	Errout.

From-SVN: r125374

gcc/ada/comperr.adb

@@ -121,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");

gcc/ada/errout.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -31,9 +31,10 @@
 
 with Err_Vars;
 with Erroutc;
+with Namet;    use Namet;
 with Table;
-with Types; use Types;
-with Uintp; use Uintp;
+with Types;    use Types;
+with Uintp;    use Uintp;
 
 with System;
 
@@ -147,7 +148,15 @@ package Errout is
    --      message, similarly replaced by the names which are specified by the
    --      Name_Id values stored in Error_Msg_Name_2 and Error_Msg_Name_3. The
    --      names are decoded and cased according to the current identifier
-   --      casing mode.
+   --      casing mode. Note: if a unit name ending with %b or %s is passed
+   --      for this kind of insertion, this suffix is simply stripped. Use a
+   --      unit name insertion ($) to process the suffix.
+
+   --    Insertion character %% (Double percent: insert literal name)
+   --      The character sequence %% acts as described above for %, except
+   --      that the name is simply obtained with Get_Name_String and is not
+   --      decoded or cased, it is inserted literally from the names table.
+   --      A trailing %b or %s is not treated specially.
 
    --    Insertion character $ (Dollar: insert unit name from Names table)
    --      The character $ is treated similarly to %, except that the name is
@@ -157,11 +166,13 @@ package Errout is
    --      strings. If this postfix is not required, use the normal %
    --      insertion for the unit name.
 
-   --    Insertion character { (Left brace: insert literally from names table)
-   --      The character { is treated similarly to %, except that the name is
-   --      output literally as stored in the names table without adjusting the
-   --      casing. This can be used for file names and in other situations
-   --      where the name string is to be output unchanged.
+   --    Insertion character { (Left brace: insert file name from names table)
+   --      The character { is treated similarly to %, except that the input
+   --      value is a File_Name_Type value stored in Error_Msg_File_1 or
+   --      Error_Msg_File_2 or Error_Msg_File_3. The value is output literally,
+   --      enclosed in quotes as for %, but the case is not modified, the
+   --      insertion is the exact string stored in the names table without
+   --      adjusting the casing.
 
    --    Insertion character * (Asterisk, insert reserved word name)
    --      The insertion character * is treated exactly like % except that the
@@ -384,9 +395,14 @@ package Errout is
    Error_Msg_Name_3 : Name_Id renames Err_Vars.Error_Msg_Name_3;
    --  Name_Id values for % insertion characters in message
 
-   Error_Msg_Unit_1 : Name_Id renames Err_Vars.Error_Msg_Unit_1;
-   Error_Msg_Unit_2 : Name_Id renames Err_Vars.Error_Msg_Unit_2;
-   --  Name_Id values for $ insertion characters in message
+   Error_Msg_File_1 : File_Name_Type renames Err_Vars.Error_Msg_File_1;
+   Error_Msg_File_2 : File_Name_Type renames Err_Vars.Error_Msg_File_2;
+   Error_Msg_File_3 : File_Name_Type renames Err_Vars.Error_Msg_File_3;
+   --  File_Name_Type values for { insertion characters in message
+
+   Error_Msg_Unit_1 : Unit_Name_Type renames Err_Vars.Error_Msg_Unit_1;
+   Error_Msg_Unit_2 : Unit_Name_Type renames Err_Vars.Error_Msg_Unit_2;
+   --  Unit_Name_Type values for $ insertion characters in message
 
    Error_Msg_Node_1 : Node_Id renames Err_Vars.Error_Msg_Node_1;
    Error_Msg_Node_2 : Node_Id renames Err_Vars.Error_Msg_Node_2;
@@ -545,8 +561,21 @@ package Errout is
    --  source file before using any of the other routines in the package.
 
    procedure Finalize;
-   --  Finalize processing of error messages for one file and output message
-   --  indicating the number of detected errors.
+   --  Finalize processing of error message list. Includes processing for
+   --  duplicated error messages, and other similar final adjustment of the
+   --  list of error messages. Note that this procedure must be called before
+   --  calling Compilation_Errors to determine if there were any errors. It
+   --  is perfectly fine to call Finalize more than once. Indeed this can
+   --  make good sense. For example, do some processing that may generate
+   --  messages. Call Finalize to eliminate duplicates and remove deleted
+   --  warnings. Test for compilation errors using Compilation_Errors, then
+   --  generate some more errors/warnings, call Finalize again to make sure
+   --  that all duplicates in these new messages are dealt with, then finally
+   --  call Output_Messages to output the final list of messages.
+
+   procedure Output_Messages;
+   --  Output list of messages, including messages giving number of detected
+   --  errors and warnings.
 
    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr);
    --  Output a message at specified location. Can be called from the parser
@@ -687,10 +716,10 @@ package Errout is
    --  the pragma. Err is set to True on return to report the error of no
    --  matching Warnings Off pragma preceding this one.
 
-   function Compilation_Errors return Boolean
-     renames Erroutc.Compilation_Errors;
+   function Compilation_Errors return Boolean;
    --  Returns true if errors have been detected, or warnings in -gnatwe
-   --  (treat warnings as errors) mode.
+   --  (treat warnings as errors) mode. Note that it is mandatory to call
+   --  Finalize before calling this routine.
 
    procedure Error_Msg_CRT (Feature : String; N : Node_Id);
    --  Posts a non-fatal message on node N saying that the feature identified

gcc/ada/prepcomp.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2003-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 2003-2007, 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- --
@@ -27,7 +27,6 @@
 with Ada.Unchecked_Deallocation;
 
 with Errout;   use Errout;
-with Namet;    use Namet;
 with Lib.Writ; use Lib.Writ;
 with Opt;      use Opt;
 with Osint;    use Osint;
@@ -37,6 +36,7 @@ with Scn;      use Scn;
 with Sinput.L; use Sinput.L;
 with Stringt;  use Stringt;
 with Table;
+with Types;    use Types;
 
 package body Prepcomp is
 
@@ -69,20 +69,20 @@ package body Prepcomp is
 
    type Preproc_Data is record
       Mapping      : Symbol_Table.Instance;
-      File_Name    : Name_Id   := No_Name;
-      Deffile      : String_Id := No_String;
-      Undef_False  : Boolean   := False;
-      Always_Blank : Boolean   := False;
-      Comments     : Boolean   := False;
-      List_Symbols : Boolean   := False;
-      Processed    : Boolean   := False;
+      File_Name    : File_Name_Type := No_File;
+      Deffile      : String_Id      := No_String;
+      Undef_False  : Boolean        := False;
+      Always_Blank : Boolean        := False;
+      Comments     : Boolean        := False;
+      List_Symbols : Boolean        := False;
+      Processed    : Boolean        := False;
    end record;
    --  Structure to keep the preprocessing data for a file name or for the
    --  default (when Name_Id = No_Name).
 
    No_Preproc_Data : constant Preproc_Data :=
      (Mapping      => No_Mapping,
-      File_Name    => No_Name,
+      File_Name    => No_File,
       Deffile      => No_String,
       Undef_False  => False,
       Always_Blank => False,
@@ -295,7 +295,7 @@ package body Prepcomp is
                   if Current_Data.File_Name =
                        Preproc_Data_Table.Table (Index).File_Name
                   then
-                     Error_Msg_Name_1 := Current_Data.File_Name;
+                     Error_Msg_File_1 := Current_Data.File_Name;
                      Error_Msg
                        ("multiple preprocessing data for{", Token_Ptr);
                      OK := False;
@@ -544,7 +544,7 @@ package body Prepcomp is
 
          --  Record Current_Data
 
-         if Current_Data.File_Name = No_Name then
+         if Current_Data.File_Name = No_File then
             Default_Data := Current_Data;
 
          else
@@ -561,6 +561,7 @@ package body Prepcomp is
 
       if Total_Errors_Detected > T then
          Errout.Finalize;
+         Errout.Output_Messages;
          Fail ("errors found in preprocessing data file """,
                Get_Name_String (N),
                """");
@@ -648,10 +649,11 @@ package body Prepcomp is
          String_To_Name_Buffer (Current_Data.Deffile);
 
          declare
-            N : constant Name_Id := Name_Find;
-            Deffile : constant Source_File_Index :=  Load_Definition_File (N);
-            Add_Deffile : Boolean := True;
-            T : constant Nat := Total_Errors_Detected;
+            N           : constant File_Name_Type    := Name_Find;
+            Deffile     : constant Source_File_Index :=
+                            Load_Definition_File (N);
+            Add_Deffile : Boolean                    := True;
+            T           : constant Nat               := Total_Errors_Detected;
 
          begin
             if Deffile = No_Source_File then
@@ -686,6 +688,7 @@ package body Prepcomp is
 
             if T /= Total_Errors_Detected then
                Errout.Finalize;
+               Errout.Output_Messages;
                Fail ("errors found in definition file """,
                      Get_Name_String (N),
                      """");

gcc/ada/prepcomp.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2002-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2007, 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- --
@@ -26,7 +26,7 @@
 
 --  This package stores all preprocessing data for the compiler
 
-with Types; use Types;
+with Namet; use Namet;
 
 package Prepcomp is