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