with Err_Vars; use Err_Vars;
with Erroutc; use Erroutc;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
with Scans; use Scans;
with Sinput; use Sinput;
package body Errutil is
Errors_Must_Be_Ignored : Boolean := False;
procedure Error_Msg_AP (Msg : String);
procedure Output_Source_Line
(L : Physical_Line_Number;
Sfile : Source_File_Index;
Errs : Boolean;
Source_Type : String);
procedure Set_Msg_Insertion_Column;
procedure Set_Msg_Text (Text : String; Flag : Source_Ptr);
procedure Error_Msg_AP (Msg : String) is
S1 : Source_Ptr;
C : Character;
begin
S1 := Prev_Token_Ptr;
C := Source (S1);
if Prev_Token = Tok_String_Literal then
loop
S1 := S1 + 1;
if Source (S1) = C then
S1 := S1 + 1;
exit when Source (S1) /= C;
elsif Source (S1) in Line_Terminator then
exit;
end if;
end loop;
elsif Prev_Token = Tok_Char_Literal then
S1 := S1 + 3;
else
while Source (S1) not in Line_Terminator
and then Source (S1) /= ' '
and then Source (S1) /= ASCII.HT
and then (Source (S1) /= '-' or else Source (S1 + 1) /= '-')
and then S1 /= Token_Ptr
loop
S1 := S1 + 1;
end loop;
end if;
Error_Msg (Msg, S1);
end Error_Msg_AP;
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
Next_Msg : Error_Msg_Id;
Prev_Msg : Error_Msg_Id;
Sptr : Source_Ptr renames Flag_Location;
Optr : Source_Ptr renames Flag_Location;
begin
if Errors_Must_Be_Ignored then
return;
end if;
if Raise_Exception_On_Error /= 0 then
raise Error_Msg_Exception;
end if;
Test_Style_Warning_Serious_Msg (Msg);
Set_Msg_Text (Msg, Sptr);
if Continuation and Last_Killed then
return;
end if;
if Is_Warning_Msg and then Warnings_Suppressed (Sptr) then
Cur_Msg := No_Error_Msg;
return;
end if;
Errors.Increment_Last;
Cur_Msg := Errors.Last;
Errors.Table (Cur_Msg).Text := new String'(Msg_Buffer (1 .. Msglen));
Errors.Table (Cur_Msg).Next := No_Error_Msg;
Errors.Table (Cur_Msg).Sptr := Sptr;
Errors.Table (Cur_Msg).Optr := Optr;
Errors.Table (Cur_Msg).Sfile := Get_Source_File_Index (Sptr);
Errors.Table (Cur_Msg).Line := Get_Physical_Line_Number (Sptr);
Errors.Table (Cur_Msg).Col := Get_Column_Number (Sptr);
Errors.Table (Cur_Msg).Style := Is_Style_Msg;
Errors.Table (Cur_Msg).Warn := Is_Warning_Msg;
Errors.Table (Cur_Msg).Serious := Is_Serious_Error;
Errors.Table (Cur_Msg).Uncond := Is_Unconditional_Msg;
Errors.Table (Cur_Msg).Msg_Cont := Continuation;
Errors.Table (Cur_Msg).Deleted := False;
Prev_Msg := No_Error_Msg;
Next_Msg := First_Error_Msg;
while Next_Msg /= No_Error_Msg loop
exit when
Errors.Table (Cur_Msg).Sfile < Errors.Table (Next_Msg).Sfile;
if Errors.Table (Cur_Msg).Sfile = Errors.Table (Next_Msg).Sfile then
exit when Sptr < Errors.Table (Next_Msg).Sptr;
end if;
Prev_Msg := Next_Msg;
Next_Msg := Errors.Table (Next_Msg).Next;
end loop;
if Prev_Msg /= No_Error_Msg
and then Errors.Table (Prev_Msg).Line =
Errors.Table (Cur_Msg).Line
and then Errors.Table (Prev_Msg).Sfile =
Errors.Table (Cur_Msg).Sfile
then
if not Errors.Table (Cur_Msg).Uncond
and then not Continuation
then
if not (Errors.Table (Prev_Msg).Warn
or
Errors.Table (Prev_Msg).Style)
or else
(Errors.Table (Cur_Msg).Warn
or
Errors.Table (Cur_Msg).Style)
then
if not Continuation then
Last_Killed := True;
end if;
return;
end if;
end if;
end if;
if not Continuation then
Last_Killed := False;
end if;
if Prev_Msg = No_Error_Msg then
First_Error_Msg := Cur_Msg;
else
Errors.Table (Prev_Msg).Next := Cur_Msg;
end if;
Errors.Table (Cur_Msg).Next := Next_Msg;
if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
Warnings_Detected := Warnings_Detected + 1;
else
Total_Errors_Detected := Total_Errors_Detected + 1;
if Errors.Table (Cur_Msg).Serious then
Serious_Errors_Detected := Serious_Errors_Detected + 1;
end if;
end if;
end Error_Msg;
procedure Error_Msg_S (Msg : String) is
begin
Error_Msg (Msg, Scan_Ptr);
end Error_Msg_S;
procedure Error_Msg_SC (Msg : String) is
begin
if Token = Tok_EOF then
Error_Msg_AP (Msg);
else
Error_Msg (Msg, Token_Ptr);
end if;
end Error_Msg_SC;
procedure Error_Msg_SP (Msg : String) is
begin
Error_Msg (Msg, Prev_Token_Ptr);
end Error_Msg_SP;
procedure Finalize (Source_Type : String := "project") is
Cur : Error_Msg_Id;
Nxt : Error_Msg_Id;
E, F : Error_Msg_Id;
Err_Flag : Boolean;
begin
Cur := First_Error_Msg;
while Cur /= No_Error_Msg loop
Nxt := Errors.Table (Cur).Next;
F := Nxt;
while F /= No_Error_Msg
and then Errors.Table (F).Sptr = Errors.Table (Cur).Sptr
loop
Check_Duplicate_Message (Cur, F);
F := Errors.Table (F).Next;
end loop;
Cur := Nxt;
end loop;
if Brief_Output or (not Full_List and not Verbose_Mode) then
E := First_Error_Msg;
Set_Standard_Error;
while E /= No_Error_Msg loop
if not Errors.Table (E).Deleted then
if Full_Path_Name_For_Brief_Errors then
Write_Name (Full_Ref_Name (Errors.Table (E).Sfile));
else
Write_Name (Reference_Name (Errors.Table (E).Sfile));
end if;
Write_Char (':');
Write_Int (Int (Physical_To_Logical
(Errors.Table (E).Line,
Errors.Table (E).Sfile)));
Write_Char (':');
if Errors.Table (E).Col < 10 then
Write_Char ('0');
end if;
Write_Int (Int (Errors.Table (E).Col));
Write_Str (": ");
Output_Msg_Text (E);
Write_Eol;
end if;
E := Errors.Table (E).Next;
end loop;
Set_Standard_Output;
end if;
if Full_List then
List_Pragmas_Index := 1;
List_Pragmas_Mode := True;
E := First_Error_Msg;
Write_Eol;
for N in 1 .. Last_Source_Line (Main_Source_File) loop
Err_Flag :=
E /= No_Error_Msg
and then Errors.Table (E).Line = N
and then Errors.Table (E).Sfile = Main_Source_File;
Output_Source_Line (N, Main_Source_File, Err_Flag, Source_Type);
if Err_Flag then
Output_Error_Msgs (E);
Write_Eol;
end if;
end loop;
while E /= No_Error_Msg
and then Errors.Table (E).Sfile /= Main_Source_File
loop
Write_Eol;
Output_Source_Line
(Errors.Table (E).Line,
Errors.Table (E).Sfile,
True,
Source_Type);
Output_Error_Msgs (E);
end loop;
end if;
if Verbose_Mode then
E := First_Error_Msg;
while E /= No_Error_Msg loop
Write_Eol;
Output_Source_Line
(Errors.Table (E).Line,
Errors.Table (E).Sfile,
True,
Source_Type);
Output_Error_Msgs (E);
end loop;
end if;
if Verbose_Mode or else Full_List then
if Total_Errors_Detected + Warnings_Detected > 0
or else Full_List
then
Write_Eol;
end if;
if Total_Errors_Detected + Warnings_Detected /= 0
and then not Brief_Output
and then (Verbose_Mode or Full_List)
then
Set_Standard_Error;
end if;
Write_Str (" ");
Write_Int (Num_Source_Lines (Main_Source_File));
if Num_Source_Lines (Main_Source_File) = 1 then
Write_Str (" line: ");
else
Write_Str (" lines: ");
end if;
if Total_Errors_Detected = 0 then
Write_Str ("No errors");
elsif Total_Errors_Detected = 1 then
Write_Str ("1 error");
else
Write_Int (Total_Errors_Detected);
Write_Str (" errors");
end if;
if Warnings_Detected /= 0 then
Write_Str (", ");
Write_Int (Warnings_Detected);
Write_Str (" warning");
if Warnings_Detected /= 1 then
Write_Char ('s');
end if;
if Warning_Mode = Treat_As_Error then
Write_Str (" (treated as error");
if Warnings_Detected /= 1 then
Write_Char ('s');
end if;
Write_Char (')');
end if;
end if;
Write_Eol;
Set_Standard_Output;
end if;
if Maximum_Errors /= 0
and then Total_Errors_Detected + Warnings_Detected = Maximum_Errors
then
Set_Standard_Error;
Write_Str ("fatal error: maximum errors reached");
Write_Eol;
Set_Standard_Output;
end if;
if Warning_Mode = Treat_As_Error then
Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
Warnings_Detected := 0;
end if;
end Finalize;
procedure Initialize is
begin
Errors.Init;
First_Error_Msg := No_Error_Msg;
Last_Error_Msg := No_Error_Msg;
Serious_Errors_Detected := 0;
Total_Errors_Detected := 0;
Warnings_Detected := 0;
Cur_Msg := No_Error_Msg;
Warnings.Init;
end Initialize;
procedure Output_Source_Line
(L : Physical_Line_Number;
Sfile : Source_File_Index;
Errs : Boolean;
Source_Type : String)
is
S : Source_Ptr;
C : Character;
Line_Number_Output : Boolean := False;
begin
if Sfile /= Current_Error_Source_File then
Write_Str ("==============Error messages for ");
Write_Str (Source_Type);
Write_Str (" file: ");
Write_Name (Full_File_Name (Sfile));
Write_Eol;
Current_Error_Source_File := Sfile;
end if;
if Errs then
Output_Line_Number (Physical_To_Logical (L, Sfile));
Line_Number_Output := True;
end if;
S := Line_Start (L, Sfile);
loop
C := Source_Text (Sfile) (S);
exit when C = ASCII.LF or else C = ASCII.CR or else C = EOF;
if Errs then
Write_Char (C);
end if;
S := S + 1;
end loop;
if Line_Number_Output then
Write_Eol;
end if;
end Output_Source_Line;
procedure Set_Ignore_Errors (To : Boolean) is
begin
Errors_Must_Be_Ignored := To;
end Set_Ignore_Errors;
procedure Set_Msg_Insertion_Column is
begin
if Style.RM_Column_Check then
Set_Msg_Str (" in column ");
Set_Msg_Int (Int (Error_Msg_Col) + 1);
end if;
end Set_Msg_Insertion_Column;
procedure Set_Msg_Text (Text : String; Flag : Source_Ptr) is
C : Character; P : Natural;
begin
Manual_Quote_Mode := False;
Msglen := 0;
Flag_Source := Get_Source_File_Index (Flag);
P := Text'First;
while P <= Text'Last loop
C := Text (P);
P := P + 1;
if C = '%' then
Set_Msg_Insertion_Name;
elsif C = '$' then
null;
elsif C = '{' then
Set_Msg_Insertion_File_Name;
elsif C = '}' then
null;
elsif C = '*' then
Set_Msg_Insertion_Reserved_Name;
elsif C = '&' then
null;
elsif C = '#' then
Set_Msg_Insertion_Line_Number (Error_Msg_Sloc, Flag);
elsif C = '\' then
Continuation := True;
elsif C = '@' then
Set_Msg_Insertion_Column;
elsif C = '^' then
Set_Msg_Insertion_Uint;
elsif C = '`' then
Manual_Quote_Mode := not Manual_Quote_Mode;
Set_Msg_Char ('"');
elsif C = '!' then
Is_Unconditional_Msg := True;
elsif C = '?' then
null;
elsif C = '|' then
null;
elsif C = ''' then
Set_Msg_Char (Text (P));
P := P + 1;
elsif C in 'A' .. 'Z'
and then P <= Text'Last
and then Text (P) in 'A' .. 'Z'
then
P := P - 1;
Set_Msg_Insertion_Reserved_Word (Text, P);
else
Set_Msg_Char (C);
end if;
end loop;
end Set_Msg_Text;
end Errutil;