ada: Fix crash with -gnatdJ and -gnatw.w

This patch fixes a crash when -gnatdJ is enabled and a warning
must be emitted about an ineffective pragma Warnings clause.

Some modifications are made to the specific warnings machinery so
that warnings carry the ID of the pragma node they're about, so the
-gnatdJ mechanism can find an appropriate enclosing subprogram.

gcc/ada/

	* sem_prag.adb (Analyze_Pragma): Adapt call to new signature.
	* erroutc.ads (Set_Specific_Warning_Off): change signature
	and update documentation.
	(Validate_Specific_Warnings): Move ...
	* errout.adb: ... here and change signature. Also move body
	of Validate_Specific_Warnings from erroutc.adb.
	(Finalize): Adapt call.
	* errout.ads (Set_Specific_Warning_Off): Adapt signature of
	renaming.
	* erroutc.adb (Set_Specific_Warning_Off): Adapt signature and
	body.
	(Validate_Specific_Warnings): Move to the body of Errout.
	(Warning_Specifically_Suppressed): Adapt body.

1 files changed, 9 insertions, 16 deletions

diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 9463109..250461f 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -347,7 +347,7 @@ package Erroutc is
    --  which is the pattern to match for suppressing a warning.
 
    type Specific_Warning_Entry is record
-      Start : Source_Ptr;
+      Start : Node_Id;
       Stop  : Source_Ptr;
       --  Starting and ending source pointers for the range. These are always
       --  from the same source file.
@@ -651,7 +651,7 @@ package Erroutc is
    --  last non-deleted message.
 
    procedure Set_Specific_Warning_Off
-     (Loc    : Source_Ptr;
+     (Node   : Node_Id;
       Msg    : String;
       Reason : String_Id;
       Config : Boolean;
@@ -659,13 +659,13 @@ package Erroutc is
    --  This is called in response to the two argument form of pragma Warnings
    --  where the first argument is OFF, and the second argument is a string
    --  which identifies a specific warning to be suppressed. The first argument
-   --  is the start of the suppression range, and the second argument is the
-   --  string from the pragma. Loc is the location of the pragma (which is the
-   --  start of the range to suppress). Reason is the reason string from the
-   --  pragma, or the null string if no reason is given. Config is True for the
-   --  configuration pragma case (where there is no requirement for a matching
-   --  OFF pragma). Used is set True to disable the check that the warning
-   --  actually has the effect of suppressing a warning.
+   --  is the corresponding N_Pragma node, and the second argument is the
+   --  string from the pragma. Sloc (Node) is the start of the range to
+   --  suppress. Reason is the reason string from the pragma, or the null
+   --  string if no reason is given. Config is True for the configuration
+   --  pragma case (where there is no requirement for a matching OFF pragma).
+   --  Used is set True to disable the check that the warning actually has the
+   --  effect of suppressing a warning.
 
    procedure Set_Specific_Warning_On
      (Loc : Source_Ptr;
@@ -717,11 +717,4 @@ package Erroutc is
    --  given by Warning_As_Error pragmas, as stored in the Warnings_As_Errors
    --  table.
 
-   type Error_Msg_Proc is
-     access procedure (Msg : String; Flag_Location : Source_Ptr);
-   procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc);
-   --  Checks that specific warnings are consistent (for non-configuration
-   --  case, properly closed, and used). The argument is a pointer to the
-   --  Error_Msg procedure to be called if any inconsistencies are detected.
-
 end Erroutc;