/usr/share/ada/adainclude/gnatprj/binderr.adb is in libgnatprj4.9-dev 4.9.2-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | ------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B I N D E R R --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Butil; use Butil;
with Opt; use Opt;
with Output; use Output;
package body Binderr is
---------------
-- Error_Msg --
---------------
procedure Error_Msg (Msg : String) is
begin
if Msg (Msg'First) = '?' then
if Warning_Mode = Suppress then
return;
end if;
if Warning_Mode = Treat_As_Error then
Errors_Detected := Errors_Detected + 1;
else
Warnings_Detected := Warnings_Detected + 1;
end if;
else
Errors_Detected := Errors_Detected + 1;
end if;
if Brief_Output or else (not Verbose_Mode) then
Set_Standard_Error;
Error_Msg_Output (Msg, Info => False);
Set_Standard_Output;
end if;
if Verbose_Mode then
if Errors_Detected + Warnings_Detected = 0 then
Write_Eol;
end if;
Error_Msg_Output (Msg, Info => False);
end if;
-- If too many warnings print message and then turn off warnings
if Warnings_Detected = Maximum_Messages then
Set_Standard_Error;
Write_Line ("maximum number of warnings reached");
Write_Line ("further warnings will be suppressed");
Set_Standard_Output;
Warning_Mode := Suppress;
end if;
-- If too many errors print message and give fatal error
if Errors_Detected = Maximum_Messages then
Set_Standard_Error;
Write_Line ("fatal error: maximum number of errors exceeded");
Set_Standard_Output;
raise Unrecoverable_Error;
end if;
end Error_Msg;
--------------------
-- Error_Msg_Info --
--------------------
procedure Error_Msg_Info (Msg : String) is
begin
if Brief_Output or else (not Verbose_Mode) then
Set_Standard_Error;
Error_Msg_Output (Msg, Info => True);
Set_Standard_Output;
end if;
if Verbose_Mode then
Error_Msg_Output (Msg, Info => True);
end if;
end Error_Msg_Info;
----------------------
-- Error_Msg_Output --
----------------------
procedure Error_Msg_Output (Msg : String; Info : Boolean) is
Use_Second_File : Boolean := False;
Use_Second_Unit : Boolean := False;
Use_Second_Nat : Boolean := False;
Warning : Boolean := False;
begin
if Warnings_Detected + Errors_Detected > Maximum_Messages then
Write_Str ("error: maximum errors exceeded");
Write_Eol;
return;
end if;
-- First, check for warnings
for J in Msg'Range loop
if Msg (J) = '?' then
Warning := True;
exit;
end if;
end loop;
if Warning then
Write_Str ("warning: ");
elsif Info then
if not Info_Prefix_Suppress then
Write_Str ("info: ");
end if;
else
Write_Str ("error: ");
end if;
for J in Msg'Range loop
if Msg (J) = '%' then
Get_Name_String (Error_Msg_Name_1);
Write_Char ('"');
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Char ('"');
elsif Msg (J) = '{' then
if Use_Second_File then
Get_Name_String (Error_Msg_File_2);
else
Use_Second_File := True;
Get_Name_String (Error_Msg_File_1);
end if;
Write_Char ('"');
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Char ('"');
elsif Msg (J) = '$' then
Write_Char ('"');
if Use_Second_Unit then
Write_Unit_Name (Error_Msg_Unit_2);
else
Use_Second_Unit := True;
Write_Unit_Name (Error_Msg_Unit_1);
end if;
Write_Char ('"');
elsif Msg (J) = '#' then
if Use_Second_Nat then
Write_Int (Error_Msg_Nat_2);
else
Use_Second_Nat := True;
Write_Int (Error_Msg_Nat_1);
end if;
elsif Msg (J) /= '?' then
Write_Char (Msg (J));
end if;
end loop;
Write_Eol;
end Error_Msg_Output;
----------------------
-- Finalize_Binderr --
----------------------
procedure Finalize_Binderr is
begin
-- Message giving number of errors detected (verbose mode only)
if Verbose_Mode then
Write_Eol;
if Errors_Detected = 0 then
Write_Str ("No errors");
elsif Errors_Detected = 1 then
Write_Str ("1 error");
else
Write_Int (Errors_Detected);
Write_Str (" errors");
end if;
if Warnings_Detected = 1 then
Write_Str (", 1 warning");
elsif Warnings_Detected > 1 then
Write_Str (", ");
Write_Int (Warnings_Detected);
Write_Str (" warnings");
end if;
Write_Eol;
end if;
end Finalize_Binderr;
------------------------
-- Initialize_Binderr --
------------------------
procedure Initialize_Binderr is
begin
Errors_Detected := 0;
Warnings_Detected := 0;
end Initialize_Binderr;
end Binderr;
|