E : Node_Or_Entity_Id;
Flag_Location : Source_Ptr)
is
+ Fst, Lst : Node_Id;
begin
- Error_Msg_NEL (Msg, N, E, To_Span (Flag_Location));
+ First_And_Last_Nodes (N, Fst, Lst);
+ Error_Msg_NEL
+ (Msg, N, E,
+ To_Span (Ptr => Flag_Location,
+ First => Source_Ptr'Min (Flag_Location, First_Sloc (Fst)),
+ Last => Source_Ptr'Max (Flag_Location, Last_Sloc (Lst))));
end Error_Msg_NEL;
procedure Error_Msg_NEL
and then Get_Source_File_Index (Loc) = Sfile
then
Latest := Norig;
- Lloc := Loc;
+ Lloc := Loc;
end if;
return OK_Orig;
| N_Pragma
| N_Use_Type_Clause
| N_With_Clause
+ | N_Attribute_Definition_Clause
+ | N_Subtype_Indication
then
Earliest := Orig;
Eloc := Loc;
procedure Write_Source_Code_Lines (Span : Source_Span) is
+ function Get_Line_End
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr) return Source_Ptr;
+ -- Get the source location for the end of the line in Buf for Loc
+
+ function Get_Line_Start
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr) return Source_Ptr;
+ -- Get the source location for the start of the line in Buf for Loc
+
function Image (X : Positive; Width : Positive) return String;
-- Output number X over Width characters, with whitespace padding.
-- Only output the low-order Width digits of X, if X is larger than
-- Width digits.
+ procedure Write_Buffer
+ (Buf : Source_Buffer_Ptr;
+ First : Source_Ptr;
+ Last : Source_Ptr);
+ -- Output the characters from First to Last position in Buf, using
+ -- Write_Buffer_Char.
+
+ procedure Write_Buffer_Char
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr);
+ -- Output the characters at position Loc in Buf, translating ASCII.HT
+ -- in a suitable number of spaces so that the output is not modified
+ -- by starting in a different column that 1.
+
procedure Write_Line_Marker
(Num : Pos;
Mark : Boolean;
-- a Mark to denote the line with the main location when reporting
-- a span over multiple lines.
+ ------------------
+ -- Get_Line_End --
+ ------------------
+
+ function Get_Line_End
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr) return Source_Ptr
+ is
+ Cur_Loc : Source_Ptr := Loc;
+ begin
+ while Cur_Loc <= Buf'Last
+ and then Buf (Cur_Loc) /= ASCII.LF
+ loop
+ Cur_Loc := Cur_Loc + 1;
+ end loop;
+
+ return Cur_Loc;
+ end Get_Line_End;
+
+ --------------------
+ -- Get_Line_Start --
+ --------------------
+
+ function Get_Line_Start
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr) return Source_Ptr
+ is
+ Cur_Loc : Source_Ptr := Loc;
+ begin
+ while Cur_Loc > Buf'First
+ and then Buf (Cur_Loc - 1) /= ASCII.LF
+ loop
+ Cur_Loc := Cur_Loc - 1;
+ end loop;
+
+ return Cur_Loc;
+ end Get_Line_Start;
+
-----------
-- Image --
-----------
return Str;
end Image;
+ ------------------
+ -- Write_Buffer --
+ ------------------
+
+ procedure Write_Buffer
+ (Buf : Source_Buffer_Ptr;
+ First : Source_Ptr;
+ Last : Source_Ptr)
+ is
+ begin
+ for Loc in First .. Last loop
+ Write_Buffer_Char (Buf, Loc);
+ end loop;
+ end Write_Buffer;
+
+ -----------------------
+ -- Write_Buffer_Char --
+ -----------------------
+
+ procedure Write_Buffer_Char
+ (Buf : Source_Buffer_Ptr;
+ Loc : Source_Ptr)
+ is
+ begin
+ -- If the character ASCII.HT is not the last one in the file,
+ -- output as many spaces as the character represents in the
+ -- original source file.
+
+ if Buf (Loc) = ASCII.HT
+ and then Loc < Buf'Last
+ then
+ for X in Get_Column_Number (Loc) ..
+ Get_Column_Number (Loc + 1) - 1
+ loop
+ Write_Char (' ');
+ end loop;
+
+ -- Otherwise output the character itself
+
+ else
+ Write_Char (Buf (Loc));
+ end if;
+ end Write_Buffer_Char;
+
-----------------------
-- Write_Line_Marker --
-----------------------
if Loc >= First_Source_Ptr then
Buf := Source_Text (Get_Source_File_Index (Loc));
- -- First line of the span with actual source code
+ -- First line of the span with actual source code. We retrieve
+ -- the beginning of the line instead of relying on Col_Fst, as
+ -- ASCII.HT characters change column numbers by possibly more
+ -- than one.
Write_Line_Marker
(Cur_Line,
Line_Fst /= Line_Lst and then Cur_Line = Line,
Width);
- Write_Str
- (String (Buf (Fst - Source_Ptr (Col_Fst) + 1 .. Fst - 1)));
+ Write_Buffer (Buf, Get_Line_Start (Buf, Cur_Loc), Cur_Loc - 1);
- -- Output all the lines in the span
+ -- Output the first/caret/last lines of the span, as well as
+ -- lines that are directly above/below the caret if they complete
+ -- the gap with first/last lines, otherwise use ... to denote
+ -- intermediate lines.
- while Cur_Loc <= Buf'Last
- and then Cur_Loc < Lst
- loop
- Write_Char (Buf (Cur_Loc));
- Cur_Loc := Cur_Loc + 1;
+ declare
+ function Do_Write_Line (Cur_Line : Pos) return Boolean is
+ (Cur_Line in Line_Fst | Line | Line_Lst
+ or else
+ (Cur_Line = Line_Fst + 1 and then Cur_Line = Line - 1)
+ or else
+ (Cur_Line = Line + 1 and then Cur_Line = Line_Lst - 1));
+ begin
+ while Cur_Loc <= Buf'Last
+ and then Cur_Loc < Lst
+ loop
+ if Do_Write_Line (Cur_Line) then
+ Write_Buffer_Char (Buf, Cur_Loc);
+ end if;
- if Buf (Cur_Loc - 1) = ASCII.LF then
- Cur_Line := Cur_Line + 1;
- Write_Line_Marker
- (Cur_Line,
- Line_Fst /= Line_Lst and then Cur_Line = Line,
- Width);
- end if;
- end loop;
+ Cur_Loc := Cur_Loc + 1;
- -- Output the rest of the last line of the span
+ if Buf (Cur_Loc - 1) = ASCII.LF then
+ Cur_Line := Cur_Line + 1;
- while Cur_Loc <= Buf'Last
- and then Buf (Cur_Loc) /= ASCII.LF
- loop
- Write_Char (Buf (Cur_Loc));
- Cur_Loc := Cur_Loc + 1;
- end loop;
+ -- Output ... for skipped lines
- Write_Eol;
+ if (Cur_Line = Line
+ and then not Do_Write_Line (Cur_Line - 1))
+ or else
+ (Cur_Line = Line + 1
+ and then not Do_Write_Line (Cur_Line))
+ then
+ Write_Str ((1 .. Width - 3 => ' ') & "... | ...");
+ Write_Eol;
+ end if;
+
+ -- Display the line marker if the line should be
+ -- displayed.
+
+ if Do_Write_Line (Cur_Line) then
+ Write_Line_Marker
+ (Cur_Line,
+ Line_Fst /= Line_Lst and then Cur_Line = Line,
+ Width);
+ end if;
+ end if;
+ end loop;
+ end;
+
+ -- Output the rest of the last line of the span
+
+ Write_Buffer (Buf, Cur_Loc, Get_Line_End (Buf, Cur_Loc));
-- If the span is on one line, output a second line with caret
-- sign pointing to location Loc
and then Compile_Time_Known_Value (C)
and then Expr_Value (C) = Lo
then
- Error_Msg_N ("duplication of choice value: &#!", C);
+ Error_Msg_N
+ ("duplication of choice value: &#!", Original_Node (C));
-- Not that special case, so just output the integer value
else
Error_Msg_Uint_1 := Lo;
- Error_Msg_N ("duplication of choice value: ^#!", C);
+ Error_Msg_N
+ ("duplication of choice value: ^#!", Original_Node (C));
end if;
-- Enumeration type
else
Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
- Error_Msg_N ("duplication of choice value: %#!", C);
+ Error_Msg_N
+ ("duplication of choice value: %#!", Original_Node (C));
end if;
-- More than one choice value, so print range of values
else
Error_Msg_Uint_1 := Lo;
Error_Msg_Uint_2 := Hi;
- Error_Msg_N ("duplication of choice values: ^ .. ^#!", C);
+ Error_Msg_N
+ ("duplication of choice values: ^ .. ^#!",
+ Original_Node (C));
end if;
-- Enumeration type
else
Error_Msg_Name_1 := Choice_Image (Lo, Bounds_Type);
Error_Msg_Name_2 := Choice_Image (Hi, Bounds_Type);
- Error_Msg_N ("duplication of choice values: % .. %#!", C);
+ Error_Msg_N
+ ("duplication of choice values: % .. %#!", Original_Node (C));
end if;
end if;
end Dup_Choice;
then
C := New_Copy (P);
Set_Sloc (C, Sloc (Choice));
+ Set_Original_Node (C, Choice);
if Expr_Value (Low_Bound (C)) < Expr_Value (Lo) then
Set_Low_Bound (C, Lo);
projects / platform / upstream / gcc.git / commitdiff