OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [binderr.adb] - Blame information for rev 797

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

Line No. Rev Author Line
1 706 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.