gcc/ada/binderr.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              B I N D E R R                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Butil;   use Butil;
  28 with Namet;   use Namet;
  29 with Opt;     use Opt;
  30 with Output;  use Output;
  31
  32 package body Binderr is
  33
  34    ---------------
  35    -- Error_Msg --
  36    ---------------
  37
  38    procedure Error_Msg (Msg : String) is
  39    begin
  40       if Msg (Msg'First) = '?' then
  41          if Warning_Mode = Suppress then
  42             return;
  43          end if;
  44
  45          if Warning_Mode = Treat_As_Error then
  46             Errors_Detected := Errors_Detected + 1;
  47          else
  48             Warnings_Detected := Warnings_Detected + 1;
  49          end if;
  50
  51       else
  52          Errors_Detected := Errors_Detected + 1;
  53       end if;
  54
  55       if Brief_Output or else (not Verbose_Mode) then
  56          Set_Standard_Error;
  57          Error_Msg_Output (Msg, Info => False);
  58          Set_Standard_Output;
  59       end if;
  60
  61       if Verbose_Mode then
  62          if Errors_Detected + Warnings_Detected = 0 then
  63             Write_Eol;
  64          end if;
  65
  66          Error_Msg_Output (Msg, Info => False);
  67       end if;
  68
  69       if Warnings_Detected + Errors_Detected > Maximum_Errors then
  70          raise Unrecoverable_Error;
  71       end if;
  72
  73    end Error_Msg;
  74
  75    --------------------
  76    -- Error_Msg_Info --
  77    --------------------
  78
  79    procedure Error_Msg_Info (Msg : String) is
  80    begin
  81       if Brief_Output or else (not Verbose_Mode) then
  82          Set_Standard_Error;
  83          Error_Msg_Output (Msg, Info => True);
  84          Set_Standard_Output;
  85       end if;
  86
  87       if Verbose_Mode then
  88          Error_Msg_Output (Msg, Info => True);
  89       end if;
  90
  91    end Error_Msg_Info;
  92
  93    ----------------------
  94    -- Error_Msg_Output --
  95    ----------------------
  96
  97    procedure Error_Msg_Output (Msg : String; Info : Boolean) is
  98       Use_Second_Name : Boolean := False;
  99       Use_Second_Nat  : Boolean := False;
 100
 101    begin
 102       if Warnings_Detected + Errors_Detected > Maximum_Errors then
 103          Write_Str ("error: maximum errors exceeded");
 104          Write_Eol;
 105          return;
 106       end if;
 107
 108       if Msg (Msg'First) = '?' then
 109          Write_Str ("warning: ");
 110       elsif Info then
 111          if not Info_Prefix_Suppress then
 112             Write_Str ("info:  ");
 113          end if;
 114       else
 115          Write_Str ("error: ");
 116       end if;
 117
 118       for J in Msg'Range loop
 119          if Msg (J) = '%' then
 120
 121             if Use_Second_Name then
 122                Get_Name_String (Error_Msg_Name_2);
 123             else
 124                Use_Second_Name := True;
 125                Get_Name_String (Error_Msg_Name_1);
 126             end if;
 127
 128             Write_Char ('"');
 129             Write_Str (Name_Buffer (1 .. Name_Len));
 130             Write_Char ('"');
 131
 132          elsif Msg (J) = '&' then
 133             Write_Char ('"');
 134
 135             if Use_Second_Name then
 136                Write_Unit_Name (Error_Msg_Name_2);
 137             else
 138                Use_Second_Name := True;
 139                Write_Unit_Name (Error_Msg_Name_1);
 140             end if;
 141
 142             Write_Char ('"');
 143
 144          elsif Msg (J) = '#' then
 145             if Use_Second_Nat then
 146                Write_Int (Error_Msg_Nat_2);
 147             else
 148                Use_Second_Nat := True;
 149                Write_Int (Error_Msg_Nat_1);
 150             end if;
 151
 152          elsif Msg (J) /= '?' then
 153             Write_Char (Msg (J));
 154          end if;
 155       end loop;
 156
 157       Write_Eol;
 158    end Error_Msg_Output;
 159
 160    ----------------------
 161    -- Finalize_Binderr --
 162    ----------------------
 163
 164    procedure Finalize_Binderr is
 165    begin
 166       --  Message giving number of errors detected (verbose mode only)
 167
 168       if Verbose_Mode then
 169          Write_Eol;
 170
 171          if Errors_Detected = 0 then
 172             Write_Str ("No errors");
 173
 174          elsif Errors_Detected = 1 then
 175             Write_Str ("1 error");
 176
 177          else
 178             Write_Int (Errors_Detected);
 179             Write_Str (" errors");
 180          end if;
 181
 182          if Warnings_Detected = 1 then
 183             Write_Str (", 1 warning");
 184
 185          elsif Warnings_Detected > 1 then
 186             Write_Str (", ");
 187             Write_Int (Warnings_Detected);
 188             Write_Str (" warnings");
 189          end if;
 190
 191          Write_Eol;
 192       end if;
 193    end Finalize_Binderr;
 194
 195    ------------------------
 196    -- Initialize_Binderr --
 197    ------------------------
 198
 199    procedure Initialize_Binderr is
 200    begin
 201       Errors_Detected := 0;
 202       Warnings_Detected := 0;
 203    end Initialize_Binderr;
 204
 205 end Binderr;