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
27with Butil;   use Butil;
28with Namet;   use Namet;
29with Opt;     use Opt;
30with Output;  use Output;
31
32package 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
205end Binderr;
206