===================================================================
@@ -881,6 +881,7 @@ package body Errout is
Errors.Append
((Text => new String'(Msg_Buffer (1 .. Msglen)),
Next => No_Error_Msg,
+ Prev => No_Error_Msg,
Sptr => Sptr,
Optr => Optr,
Sfile => Get_Source_File_Index (Sptr),
@@ -1215,6 +1216,16 @@ package body Errout is
F : Error_Msg_Id;
begin
+ -- Set Prev pointers
+
+ Cur := First_Error_Msg;
+ while Cur /= No_Error_Msg loop
+ Nxt := Errors.Table (Cur).Next;
+ exit when Nxt = No_Error_Msg;
+ Errors.Table (Nxt).Prev := Cur;
+ Cur := Nxt;
+ end loop;
+
-- Eliminate any duplicated error messages from the list. This is
-- done after the fact to avoid problems with Change_Error_Text.
@@ -1239,11 +1250,28 @@ package body Errout is
while Cur /= No_Error_Msg loop
if not Errors.Table (Cur).Deleted
and then Warning_Specifically_Suppressed
- (Errors.Table (Cur).Sptr,
- Errors.Table (Cur).Text)
+ (Errors.Table (Cur).Sptr, Errors.Table (Cur).Text)
then
Errors.Table (Cur).Deleted := True;
Warnings_Detected := Warnings_Detected - 1;
+
+ -- If this is a continuation, delete previous messages
+
+ F := Cur;
+ while Errors.Table (F).Msg_Cont loop
+ F := Errors.Table (F).Prev;
+ Errors.Table (F).Deleted := True;
+ end loop;
+
+ -- Delete any following continuations
+
+ F := Cur;
+ loop
+ F := Errors.Table (F).Next;
+ exit when F = No_Error_Msg;
+ exit when not Errors.Table (F).Msg_Cont;
+ Errors.Table (F).Deleted := True;
+ end loop;
end if;
Cur := Errors.Table (Cur).Next;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2010, 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- --
@@ -147,6 +147,11 @@ package Erroutc is
-- Pointer to next message in error chain. A value of No_Error_Msg
-- indicates the end of the chain.
+ Prev : Error_Msg_Id;
+ -- Pointer to previous message in error chain. Only set during the
+ -- Finalize procedure. A value of No_Error_Msg indicates the first
+ -- message in the chain.
+
Sfile : Source_File_Index;
-- Source table index of source file. In the case of an error that
-- refers to a template, always references the original template
This patch improves the behavior of the form of pragma Warnings where a string is given to match error text. Now continuation lines preceding and following the deleted message are also deleted (including the "in instantion" line) These test programs should both compile without any warnings pragma Warnings (Off, "*is an internal GNAT unit"); with System.OS_Lib; procedure Warn2 is begin null; end; procedure Bar4 is generic type F is (<>); type T is (<>); procedure Foo; procedure Foo is function Conv is new Unchecked_Conversion (F, T); begin null; end Foo; pragma Warnings (Off, "*types for unchecked conversion*"); procedure Glorp is new Foo(Integer_32, Unsigned_64); pragma Warnings (On, "*types for unchecked conversion*"); begin null; end Bar4; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-22 Robert Dewar <dewar@adacore.com> * errout.adb (Finalize): Set Prev pointers. (Finalize): Delete continuations for deletion by warnings off(str). * erroutc.ads: Add Prev pointer to error message structure.