-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2017, 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- --
(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
-- 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
-- Original location of Flag_Location (i.e. location in original
-- template in instantiation case, otherwise unchanged).
- Entity : Bounded_String;
-
begin
-- Return if all errors are to be ignored
Prescan_Message (Msg);
Orig_Loc := Original_Location (Flag_Location);
- if Include_Subprogram_In_Messages then
- declare
- Ent : constant Entity_Id := Current_Subprogram_Ptr.all;
- begin
- if Present (Ent) then
- Append_Unqualified_Decoded (Entity, Chars (Ent));
- else
- Append (Entity, "unknown subprogram");
- end if;
- end;
- end if;
-
-- If the current location is in an instantiation, the issue arises of
-- whether to post the message on the template or the instantiation.
-- Error_Msg_Internal to place the message in the requested location.
if Instantiation (Sindex) = No_Location then
- if Include_Subprogram_In_Messages then
- Append (Entity, ": ");
- Append (Entity, Msg);
- Error_Msg_Internal (+Entity, Flag_Location, Flag_Location, False);
- else
- Error_Msg_Internal (Msg, Flag_Location, Flag_Location, False);
- end if;
-
+ 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);
+ (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
- (Warn_Insertion & "in inlined body #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ (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
- ("style: 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);
+ (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
- ("style: in instantiation #",
- Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
+ (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
- if Include_Subprogram_In_Messages then
- Append (Entity, ": ");
- Append (Entity, Msg);
- Error_Msg_Internal
- (+Entity, Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
- else
- Error_Msg_Internal
- (Msg, Actual_Error_Loc, Flag_Location, Msg_Cont_Status);
- end if;
+ Error_Msg_Internal
+ (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
then
Debug_Output (N);
Error_Msg_Node_1 := E;
- Error_Msg (Msg, Flag_Location);
+ Error_Msg (Msg, Flag_Location, N);
else
Last_Killed := True;
-- 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));
-- 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;
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