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-2008, 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
26with Butil;  use Butil;
27with Opt;    use Opt;
28with Output; use Output;
29
30package 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
233end Binderr;
234