[Ada] pragma Warnings Off (str) should delete continuations

[Ada] pragma Warnings Off (str) should delete continuations

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 1085 bytes --]

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.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 3435 bytes --]

Index: errout.adb
===================================================================
--- errout.adb	(revision 161171)
+++ errout.adb	(working copy)
@@ -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;
Index: erroutc.ads
===================================================================
--- erroutc.ads	(revision 161073)
+++ erroutc.ads	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          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

Re: [Ada] pragma Warnings Off (str) should delete continuations

[Eric Botcazou]

> 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.

This apparently causes gnat.dg/not_null.adb to fail.

-- 
Eric Botcazou

Re: [Ada] pragma Warnings Off (str) should delete continuations

[Arnaud Charlet]

> > 	* errout.adb (Finalize): Set Prev pointers.
> > 	(Finalize): Delete continuations for deletion by warnings off(str).
> > 	* erroutc.ads: Add Prev pointer to error message structure.
> 
> This apparently causes gnat.dg/not_null.adb to fail.

Indeed, I forgot to update this test case, now done.

--- not_null.adb        (revision 161240)
+++ not_null.adb        (working copy)
@@ -11,10 +11,8 @@ procedure not_null is
 begin
    declare
       pragma Warnings (Off, "*null not allowed in null-excluding objects");
-      pragma Warnings (Off, """Constraint_Error"" will be raised at run time");
       package Inst_2 is new GPack (null);
       pragma Warnings (On, "*null not allowed in null-excluding objects");
-      pragma Warnings (On, """Constraint_Error"" will be raised at run time");
    begin
       null;
    end;