OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [binderr.adb] - Blame information for rev 454

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
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
 
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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.