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-2007, 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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 Opt;    use Opt;
  29 with Output; use Output;
  30
  31 package body Binderr is
  32
  33    ---------------
  34    -- Error_Msg --
  35    ---------------
  36
  37    procedure Error_Msg (Msg : String) is
  38    begin
  39       if Msg (Msg'First) = '?' then
  40          if Warning_Mode = Suppress then
  41             return;
  42          end if;
  43
  44          if Warning_Mode = Treat_As_Error then
  45             Errors_Detected := Errors_Detected + 1;
  46          else
  47             Warnings_Detected := Warnings_Detected + 1;
  48          end if;
  49
  50       else
  51          Errors_Detected := Errors_Detected + 1;
  52       end if;
  53
  54       if Brief_Output or else (not Verbose_Mode) then
  55          Set_Standard_Error;
  56          Error_Msg_Output (Msg, Info => False);
  57          Set_Standard_Output;
  58       end if;
  59
  60       if Verbose_Mode then
  61          if Errors_Detected + Warnings_Detected = 0 then
  62             Write_Eol;
  63          end if;
  64
  65          Error_Msg_Output (Msg, Info => False);
  66       end if;
  67
  68       if Warnings_Detected + Errors_Detected > Maximum_Errors then
  69          raise Unrecoverable_Error;
  70       end if;
  71
  72    end Error_Msg;
  73
  74    --------------------
  75    -- Error_Msg_Info --
  76    --------------------
  77
  78    procedure Error_Msg_Info (Msg : String) is
  79    begin
  80       if Brief_Output or else (not Verbose_Mode) then
  81          Set_Standard_Error;
  82          Error_Msg_Output (Msg, Info => True);
  83          Set_Standard_Output;
  84       end if;
  85
  86       if Verbose_Mode then
  87          Error_Msg_Output (Msg, Info => True);
  88       end if;
  89
  90    end Error_Msg_Info;
  91
  92    ----------------------
  93    -- Error_Msg_Output --
  94    ----------------------
  95
  96    procedure Error_Msg_Output (Msg : String; Info : Boolean) is
  97       Use_Second_File : Boolean := False;
  98       Use_Second_Unit : Boolean := False;
  99       Use_Second_Nat  : Boolean := False;
 100       Warning         : Boolean := False;
 101
 102    begin
 103       if Warnings_Detected + Errors_Detected > Maximum_Errors then
 104          Write_Str ("error: maximum errors exceeded");
 105          Write_Eol;
 106          return;
 107       end if;
 108
 109       --  First, check for warnings
 110
 111       for J in Msg'Range loop
 112          if Msg (J) = '?' then
 113             Warning := True;
 114             exit;
 115          end if;
 116       end loop;
 117
 118       if Warning then
 119          Write_Str ("warning: ");
 120       elsif Info then
 121          if not Info_Prefix_Suppress then
 122             Write_Str ("info:  ");
 123          end if;
 124       else
 125          Write_Str ("error: ");
 126       end if;
 127
 128       for J in Msg'Range loop
 129          if Msg (J) = '%' then
 130             Get_Name_String (Error_Msg_Name_1);
 131             Write_Char ('"');
 132             Write_Str (Name_Buffer (1 .. Name_Len));
 133             Write_Char ('"');
 134
 135          elsif Msg (J) = '{' then
 136             if Use_Second_File then
 137                Get_Name_String (Error_Msg_File_2);
 138             else
 139                Use_Second_File := True;
 140                Get_Name_String (Error_Msg_File_1);
 141             end if;
 142
 143             Write_Char ('"');
 144             Write_Str (Name_Buffer (1 .. Name_Len));
 145             Write_Char ('"');
 146
 147          elsif Msg (J) = '$' then
 148             Write_Char ('"');
 149
 150             if Use_Second_Unit then
 151                Write_Unit_Name (Error_Msg_Unit_2);
 152             else
 153                Use_Second_Unit := True;
 154                Write_Unit_Name (Error_Msg_Unit_1);
 155             end if;
 156
 157             Write_Char ('"');
 158
 159          elsif Msg (J) = '#' then
 160             if Use_Second_Nat then
 161                Write_Int (Error_Msg_Nat_2);
 162             else
 163                Use_Second_Nat := True;
 164                Write_Int (Error_Msg_Nat_1);
 165             end if;
 166
 167          elsif Msg (J) /= '?' then
 168             Write_Char (Msg (J));
 169          end if;
 170       end loop;
 171
 172       Write_Eol;
 173    end Error_Msg_Output;
 174
 175    ----------------------
 176    -- Finalize_Binderr --
 177    ----------------------
 178
 179    procedure Finalize_Binderr is
 180    begin
 181       --  Message giving number of errors detected (verbose mode only)
 182
 183       if Verbose_Mode then
 184          Write_Eol;
 185
 186          if Errors_Detected = 0 then
 187             Write_Str ("No errors");
 188
 189          elsif Errors_Detected = 1 then
 190             Write_Str ("1 error");
 191
 192          else
 193             Write_Int (Errors_Detected);
 194             Write_Str (" errors");
 195          end if;
 196
 197          if Warnings_Detected = 1 then
 198             Write_Str (", 1 warning");
 199
 200          elsif Warnings_Detected > 1 then
 201             Write_Str (", ");
 202             Write_Int (Warnings_Detected);
 203             Write_Str (" warnings");
 204          end if;
 205
 206          Write_Eol;
 207       end if;
 208    end Finalize_Binderr;
 209
 210    ------------------------
 211    -- Initialize_Binderr --
 212    ------------------------
 213
 214    procedure Initialize_Binderr is
 215    begin
 216       Errors_Detected := 0;
 217       Warnings_Detected := 0;
 218    end Initialize_Binderr;
 219
 220 end Binderr;