-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2018, 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- --
with Debug; use Debug;
with Einfo; use Einfo;
with Erroutc; use Erroutc;
-with Fname; use Fname;
with Gnatvsn; use Gnatvsn;
with Lib; use Lib;
with Opt; use Opt;
(Msg : String;
Sptr : Source_Ptr;
Optr : Source_Ptr;
- Msg_Cont : Boolean);
+ Msg_Cont : Boolean;
+ Node : Node_Id);
-- This is the low level routine used to post messages after dealing with
-- the issue of messages placed on instantiations (which get broken up
-- into separate calls in Error_Msg). Sptr is the location on which the
-- copy. So typically we can see Optr pointing to the template location
-- in an instantiation copy when Sptr points to the source location of
-- the actual instantiation (i.e the line with the new). Msg_Cont is
- -- set true if this is a continuation message.
+ -- set true if this is a continuation message. Node is the relevant
+ -- Node_Id for this message, to be used to compute the enclosing entity if
+ -- Opt.Include_Subprogram_In_Messages is set.
function No_Warnings (N : Node_Or_Entity_Id) return Boolean;
-- Determines if warnings should be suppressed for the given node
Warnings_Detected := Warnings_Detected - 1;
if M.Info then
- Info_Messages := Info_Messages - 1;
+ Warning_Info_Messages := Warning_Info_Messages - 1;
end if;
if M.Warn_Err then
-- referencing the generic declaration.
procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
+ begin
+ Error_Msg (Msg, Flag_Location, Current_Node);
+ end Error_Msg;
+
+ procedure Error_Msg
+ (Msg : String;
+ Flag_Location : Source_Ptr;
+ N : Node_Id)
+ is
Sindex : Source_File_Index;
-- Source index for flag location
-- template in instantiation case, otherwise unchanged).
begin
- -- It is a fatal error to issue an error message when scanning from the
- -- internal source buffer (see Sinput for further documentation)
-
- pragma Assert (Sinput.Source /= Internal_Source_Ptr);
-
-- Return if all errors are to be ignored
if Errors_Must_Be_Ignored then
-- Error_Msg_Internal to place the message in the requested location.
if Instantiation (Sindex) = No_Location then
- Error_Msg_Internal (Msg, Flag_Location, Flag_Location, False);
+ Error_Msg_Internal (Msg, Flag_Location, Flag_Location, False, N);
return;
end if;
if Inlined_Body (X) then
if Is_Info_Msg then
Error_Msg_Internal
- ("info: in inlined body #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
- elsif Is_Warning_Msg or Is_Style_Msg then
+ (Msg => "info: in inlined body #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
+
+ elsif Is_Warning_Msg then
+ Error_Msg_Internal
+ (Msg => Warn_Insertion & "in inlined body #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
+
+ elsif Is_Style_Msg then
Error_Msg_Internal
- (Warn_Insertion & "in inlined body #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ (Msg => "style: in inlined body #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
+
else
Error_Msg_Internal
- ("error in inlined body #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ (Msg => "error in inlined body #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
end if;
-- Case of generic instantiation
else
if Is_Info_Msg then
Error_Msg_Internal
- ("info: in instantiation #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
- elsif Is_Warning_Msg or else Is_Style_Msg then
+ (Msg => "info: in instantiation #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
+
+ elsif Is_Warning_Msg then
Error_Msg_Internal
- (Warn_Insertion & "in instantiation #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ (Msg => Warn_Insertion & "in instantiation #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
+
+ elsif Is_Style_Msg then
+ Error_Msg_Internal
+ (Msg => "style: in instantiation #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
+
else
Error_Msg_Internal
- ("instantiation error #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ (Msg => "instantiation error #",
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
end if;
end if;
end if;
-- Here we output the original message on the outer instantiation
Error_Msg_Internal
- (Msg, Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ (Msg => Msg,
+ Sptr => Actual_Error_Loc,
+ Optr => Flag_Location,
+ Msg_Cont => Msg_Cont_Status,
+ Node => N);
end;
end Error_Msg;
(Msg : String;
Sptr : Source_Ptr;
Optr : Source_Ptr;
- Msg_Cont : Boolean)
+ Msg_Cont : Boolean;
+ Node : Node_Id)
is
Next_Msg : Error_Msg_Id;
-- Pointer to next message at insertion point
Serious => Is_Serious_Error,
Uncond => Is_Unconditional_Msg,
Msg_Cont => Continuation,
- Deleted => False));
+ Deleted => False,
+ Node => Node));
Cur_Msg := Errors.Last;
-- Test if warning to be treated as error
-- Bump appropriate statistics counts
if Errors.Table (Cur_Msg).Info then
- Info_Messages := Info_Messages + 1;
-- Could be (usually is) both "info" and "warning"
if Errors.Table (Cur_Msg).Warn then
- Warnings_Detected := Warnings_Detected + 1;
+ Warning_Info_Messages := Warning_Info_Messages + 1;
+ Warnings_Detected := Warnings_Detected + 1;
+ else
+ Report_Info_Messages := Report_Info_Messages + 1;
end if;
elsif Errors.Table (Cur_Msg).Warn
then
Debug_Output (N);
Error_Msg_Node_1 := E;
- Error_Msg (Msg, Flag_Location);
+ Error_Msg (Msg, Flag_Location, N);
else
Last_Killed := True;
Warnings_Detected := Warnings_Detected - 1;
if Errors.Table (E).Info then
- Info_Messages := Info_Messages - 1;
- end if;
-
- if Errors.Table (E).Warn_Err then
- Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
+ Warning_Info_Messages := Warning_Info_Messages - 1;
end if;
end if;
end Delete_Warning;
-- the Main_Source line is unknown (this happens in error situations,
-- e.g. when integrated preprocessing fails).
- if Main_Source_File /= No_Source_File then
+ if Main_Source_File > No_Source_File then
Write_Str (" ");
Write_Int (Num_Source_Lines (Main_Source_File));
Write_Str (" errors");
end if;
- if Warnings_Detected - Info_Messages /= 0 then
+ if Warnings_Detected - Warning_Info_Messages /= 0 then
Write_Str (", ");
Write_Int (Warnings_Detected);
Write_Str (" warning");
- if Warnings_Detected - Info_Messages /= 1 then
+ if Warnings_Detected - Warning_Info_Messages /= 1 then
Write_Char ('s');
end if;
end if;
end if;
- if Info_Messages /= 0 then
+ if Warning_Info_Messages + Report_Info_Messages /= 0 then
Write_Str (", ");
- Write_Int (Info_Messages);
+ Write_Int (Warning_Info_Messages + Report_Info_Messages);
Write_Str (" info message");
- if Info_Messages > 1 then
+ if Warning_Info_Messages + Report_Info_Messages > 1 then
Write_Char ('s');
end if;
end if;
-- Source_Reference. This ensures outputting the proper name of
-- the source file in this situation.
- if Main_Source_File = No_Source_File
+ if Main_Source_File <= No_Source_File
or else Num_SRef_Pragmas (Main_Source_File) /= 0
then
Current_Error_Source_File := No_Source_File;
-- Only write the header if Sfile is known
- if Sfile /= No_Source_File then
+ if Sfile > No_Source_File then
Write_Header (Sfile);
Write_Eol;
end if;
-- Only output the listing if Sfile is known, to avoid
-- crashing the compiler.
- if Sfile /= No_Source_File then
+ if Sfile > No_Source_File then
for N in 1 .. Last_Source_Line (Sfile) loop
while E /= No_Error_Msg
and then Errors.Table (E).Deleted
-- Output the header only when Main_Source_File is known
- if Main_Source_File /= No_Source_File then
+ if Main_Source_File > No_Source_File then
Write_Header (Main_Source_File);
end if;
Write_Max_Errors;
+ -- Even though Warning_Info_Messages are a subclass of warnings, they
+ -- must not be treated as errors when -gnatwe is in effect.
+
if Warning_Mode = Treat_As_Error then
Total_Errors_Detected :=
- Total_Errors_Detected + Warnings_Detected;
- Warnings_Detected := Info_Messages;
+ Total_Errors_Detected + Warnings_Detected - Warning_Info_Messages;
+ Warnings_Detected := Warning_Info_Messages;
end if;
end Output_Messages;
Warnings_Detected := Warnings_Detected - 1;
if Errors.Table (E).Info then
- Info_Messages := Info_Messages - 1;
+ Warning_Info_Messages := Warning_Info_Messages - 1;
end if;
return True;
end loop;
if Nkind (N) = N_Raise_Constraint_Error
- and then Original_Node (N) /= N
+ and then Is_Rewrite_Substitution (N)
and then No (Condition (N))
then
-- Warnings may have been posted on subexpressions of the original
begin
Warnings_Treated_As_Errors := 0;
Warnings_Detected := 0;
- Info_Messages := 0;
+ Warning_Info_Messages := 0;
Warnings_As_Errors_Count := 0;
end Reset_Warnings;
-- Types in other language defined units are displayed as
-- "package-name.type-name"
- elsif
- Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Ent)))
- then
+ elsif Is_Predefined_Unit (Get_Source_Unit (Ent)) then
Get_Unqualified_Decoded_Name_String
(Unit_Name (Get_Source_Unit (Ent)));
Name_Len := Name_Len - 2;
if Sloc (Error_Msg_Node_1) > Standard_Location
and then
- not Is_Predefined_File_Name
- (Unit_File_Name (Get_Source_Unit (Error_Msg_Node_1)))
+ not Is_Predefined_Unit (Get_Source_Unit (Error_Msg_Node_1))
then
Get_Name_String (Unit_File_Name (Get_Source_Unit (Error_Msg_Node_1)));
Set_Msg_Str (" defined");
-- '[' (will be/would have been raised at run time)
when '[' =>
+
+ -- Switch the message from a warning to an error if the flag
+ -- -gnatwE is specified to treat run-time exception warnings
+ -- as errors.
+
+ if Is_Warning_Msg
+ and then Warning_Mode = Treat_Run_Time_Warnings_As_Errors
+ then
+ Is_Warning_Msg := False;
+ end if;
+
if Is_Warning_Msg then
Set_Msg_Str ("will be raised at run time");
else
projects / gcc.git / blobdiff