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 --                                                                          --
  10 --          Copyright (C) 1992-2000 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Butil;   use Butil;
  29 with Namet;   use Namet;
  30 with Opt;     use Opt;
  31 with Output;  use Output;
  32
  33 package body Binderr is
  34
  35    ---------------
  36    -- Error_Msg --
  37    ---------------
  38
  39    procedure Error_Msg (Msg : String) is
  40    begin
  41       if Msg (Msg'First) = '?' then
  42          if Warning_Mode = Suppress then
  43             return;
  44          end if;
  45
  46          if Warning_Mode = Treat_As_Error then
  47             Errors_Detected := Errors_Detected + 1;
  48          else
  49             Warnings_Detected := Warnings_Detected + 1;
  50          end if;
  51
  52       else
  53          Errors_Detected := Errors_Detected + 1;
  54       end if;
  55
  56       if Brief_Output or else (not Verbose_Mode) then
  57          Set_Standard_Error;
  58          Error_Msg_Output (Msg, Info => False);
  59          Set_Standard_Output;
  60       end if;
  61
  62       if Verbose_Mode then
  63          if Errors_Detected + Warnings_Detected = 0 then
  64             Write_Eol;
  65          end if;
  66
  67          Error_Msg_Output (Msg, Info => False);
  68       end if;
  69
  70       if Warnings_Detected + Errors_Detected > Maximum_Errors then
  71          raise Unrecoverable_Error;
  72       end if;
  73
  74    end Error_Msg;
  75
  76    --------------------
  77    -- Error_Msg_Info --
  78    --------------------
  79
  80    procedure Error_Msg_Info (Msg : String) is
  81    begin
  82       if Brief_Output or else (not Verbose_Mode) then
  83          Set_Standard_Error;
  84          Error_Msg_Output (Msg, Info => True);
  85          Set_Standard_Output;
  86       end if;
  87
  88       if Verbose_Mode then
  89          Error_Msg_Output (Msg, Info => True);
  90       end if;
  91
  92    end Error_Msg_Info;
  93
  94    ----------------------
  95    -- Error_Msg_Output --
  96    ----------------------
  97
  98    procedure Error_Msg_Output (Msg : String; Info : Boolean) is
  99       Use_Second_Name : 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 I in Msg'Range loop
 119          if Msg (I) = '%' 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 (I) = '&' 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 (I) /= '?' then
 145             Write_Char (Msg (I));
 146          end if;
 147       end loop;
 148
 149       Write_Eol;
 150    end Error_Msg_Output;
 151
 152    ----------------------
 153    -- Finalize_Binderr --
 154    ----------------------
 155
 156    procedure Finalize_Binderr is
 157    begin
 158       --  Message giving number of errors detected (verbose mode only)
 159
 160       if Verbose_Mode then
 161          Write_Eol;
 162
 163          if Errors_Detected = 0 then
 164             Write_Str ("No errors");
 165
 166          elsif Errors_Detected = 1 then
 167             Write_Str ("1 error");
 168
 169          else
 170             Write_Int (Errors_Detected);
 171             Write_Str (" errors");
 172          end if;
 173
 174          if Warnings_Detected = 1 then
 175             Write_Str (", 1 warning");
 176
 177          elsif Warnings_Detected > 1 then
 178             Write_Str (", ");
 179             Write_Int (Warnings_Detected);
 180             Write_Str (" warnings");
 181          end if;
 182
 183          Write_Eol;
 184       end if;
 185    end Finalize_Binderr;
 186
 187    ------------------------
 188    -- Initialize_Binderr --
 189    ------------------------
 190
 191    procedure Initialize_Binderr is
 192    begin
 193       Errors_Detected := 0;
 194       Warnings_Detected := 0;
 195    end Initialize_Binderr;
 196
 197 end Binderr;