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-2023, 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 too many warnings print message and then turn off warnings
  68
  69       if Warnings_Detected = Maximum_Messages then
  70          Set_Standard_Error;
  71          Write_Line ("maximum number of warnings reached");
  72          Write_Line ("further warnings will be suppressed");
  73          Set_Standard_Output;
  74          Warning_Mode := Suppress;
  75       end if;
  76
  77       --  If too many errors print message and give fatal error
  78
  79       if Errors_Detected = Maximum_Messages then
  80          Set_Standard_Error;
  81          Write_Line ("fatal error: maximum number of errors exceeded");
  82          Set_Standard_Output;
  83          raise Unrecoverable_Error;
  84       end if;
  85    end Error_Msg;
  86
  87    --------------------
  88    -- Error_Msg_Info --
  89    --------------------
  90
  91    procedure Error_Msg_Info (Msg : String) is
  92    begin
  93       if Brief_Output or else not Verbose_Mode then
  94          Set_Standard_Error;
  95          Error_Msg_Output (Msg, Info => True);
  96          Set_Standard_Output;
  97       end if;
  98
  99       if Verbose_Mode then
 100          Error_Msg_Output (Msg, Info => True);
 101       end if;
 102
 103    end Error_Msg_Info;
 104
 105    ----------------------
 106    -- Error_Msg_Output --
 107    ----------------------
 108
 109    procedure Error_Msg_Output (Msg : String; Info : Boolean) is
 110       Use_Second_File : Boolean := False;
 111       Use_Second_Unit : Boolean := False;
 112       Use_Second_Nat  : Boolean := False;
 113       Warning         : Boolean := False;
 114
 115    begin
 116       if Warnings_Detected + Errors_Detected > Maximum_Messages then
 117          Write_Str ("error: maximum errors exceeded");
 118          Write_Eol;
 119          return;
 120       end if;
 121
 122       --  First, check for warnings
 123
 124       for J in Msg'Range loop
 125          if Msg (J) = '?' then
 126             Warning := True;
 127             exit;
 128          end if;
 129       end loop;
 130
 131       if Warning then
 132          Write_Str ("warning: ");
 133       elsif Info then
 134          if not Info_Prefix_Suppress then
 135             Write_Str ("info:  ");
 136          end if;
 137       else
 138          Write_Str ("error: ");
 139       end if;
 140
 141       for J in Msg'Range loop
 142          if Msg (J) = '%' then
 143             Get_Name_String (Error_Msg_Name_1);
 144             Write_Char ('"');
 145             Write_Str (Name_Buffer (1 .. Name_Len));
 146             Write_Char ('"');
 147
 148          elsif Msg (J) = '{' then
 149             if Use_Second_File then
 150                Get_Name_String (Error_Msg_File_2);
 151             else
 152                Use_Second_File := True;
 153                Get_Name_String (Error_Msg_File_1);
 154             end if;
 155
 156             Write_Char ('"');
 157             Write_Str (Name_Buffer (1 .. Name_Len));
 158             Write_Char ('"');
 159
 160          elsif Msg (J) = '$' then
 161             Write_Char ('"');
 162
 163             if Use_Second_Unit then
 164                Write_Unit_Name (Error_Msg_Unit_2);
 165             else
 166                Use_Second_Unit := True;
 167                Write_Unit_Name (Error_Msg_Unit_1);
 168             end if;
 169
 170             Write_Char ('"');
 171
 172          elsif Msg (J) = '#' then
 173             if Use_Second_Nat then
 174                Write_Int (Error_Msg_Nat_2);
 175             else
 176                Use_Second_Nat := True;
 177                Write_Int (Error_Msg_Nat_1);
 178             end if;
 179
 180          elsif Msg (J) /= '?' then
 181             Write_Char (Msg (J));
 182          end if;
 183       end loop;
 184
 185       Write_Eol;
 186    end Error_Msg_Output;
 187
 188    ----------------------
 189    -- Finalize_Binderr --
 190    ----------------------
 191
 192    procedure Finalize_Binderr is
 193    begin
 194       --  Message giving number of errors detected (verbose mode only)
 195
 196       if Verbose_Mode then
 197          Write_Eol;
 198
 199          if Errors_Detected = 0 then
 200             Write_Str ("No errors");
 201
 202          elsif Errors_Detected = 1 then
 203             Write_Str ("1 error");
 204
 205          else
 206             Write_Int (Errors_Detected);
 207             Write_Str (" errors");
 208          end if;
 209
 210          if Warnings_Detected = 1 then
 211             Write_Str (", 1 warning");
 212
 213          elsif Warnings_Detected > 1 then
 214             Write_Str (", ");
 215             Write_Int (Warnings_Detected);
 216             Write_Str (" warnings");
 217          end if;
 218
 219          Write_Eol;
 220       end if;
 221    end Finalize_Binderr;
 222
 223    ------------------------
 224    -- Initialize_Binderr --
 225    ------------------------
 226
 227    procedure Initialize_Binderr is
 228    begin
 229       Errors_Detected := 0;
 230       Warnings_Detected := 0;
 231    end Initialize_Binderr;
 232
 233 end Binderr;