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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [binderr.adb] - Blame information for rev 16

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

Line No. Rev Author Line
1 12 jlechner 
------------------------------------------------------------------------------
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,  51  Franklin  Street,  Fifth  Floor, --
20 
-- Boston, MA 02110-1301, 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 
 
27 
with Butil;   use Butil;
28 
with Namet;   use Namet;
29 
with Opt;     use Opt;
30 
with Output;  use Output;
31 
 
32 
package 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 
 
205 
end Binderr;

powered by: WebSVN 2.1.0

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