From f5798041ac97347e52d985be37f049c6d902d282 Mon Sep 17 00:00:00 2001
From: Ronan Desplanques <desplanques@adacore.com>
Date: Wed, 14 Feb 2024 16:02:48 +0100
Subject: ada: Fix pragma Compile_Time_Error and -gnatdJ crash

This patch makes it so the diagnostics coming from occurrences of
pragma Compile_Time_Error and Compile_Time_Warning are emitted with
a node parameter so they don't cause a crash when -gnatdJ is enabled.

gcc/ada/

	* errout.ads (Error_Msg): Add node parameter.
	* errout.adb (Error_Msg): Add parameter and pass it to
	the underlying call.
	* sem_prag.adb (Validate_Compile_Time_Warning_Or_Error): Pass
	pragma node when emitting errors.
---
 gcc/ada/errout.adb   | 3 ++-
 gcc/ada/errout.ads   | 7 ++++---
 gcc/ada/sem_prag.adb | 8 ++++----
 3 files changed, 10 insertions(+), 8 deletions(-)

(limited to 'gcc/ada')

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 4622290..f10539d 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -325,12 +325,13 @@ package body Errout is
    procedure Error_Msg
       (Msg : String;
        Flag_Location : Source_Ptr;
+       N : Node_Id;
        Is_Compile_Time_Pragma : Boolean)
    is
       Save_Is_Compile_Time_Msg : constant Boolean := Is_Compile_Time_Msg;
    begin
       Is_Compile_Time_Msg := Is_Compile_Time_Pragma;
-      Error_Msg (Msg, To_Span (Flag_Location), Current_Node);
+      Error_Msg (Msg, To_Span (Flag_Location), N);
       Is_Compile_Time_Msg := Save_Is_Compile_Time_Msg;
    end Error_Msg;
 
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 089da86..f0e3f5d 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -738,10 +738,11 @@ package Errout is
    procedure Error_Msg
      (Msg                    : String;
       Flag_Location          : Source_Ptr;
+      N                      : Node_Id;
       Is_Compile_Time_Pragma : Boolean);
-   --  Same as Error_Msg (String, Source_Ptr) except Is_Compile_Time_Pragma
-   --  lets the caller specify whether this is a Compile_Time_Warning or
-   --  Compile_Time_Error pragma.
+   --  Same as Error_Msg (String, Source_Ptr, Node_Id) except
+   --  Is_Compile_Time_Pragma lets the caller specify whether this is a
+   --  Compile_Time_Warning or Compile_Time_Error pragma.
 
    procedure Error_Msg_S (Msg : String);
    --  Output a message at current scan pointer location. This routine can be
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index dfc415d..9646e89 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -33145,11 +33145,11 @@ package body Sem_Prag is
                   if Force then
                      if Cont = False then
                         Error_Msg
-                           ("<<~!!", Eloc, Is_Compile_Time_Pragma => True);
+                           ("<<~!!", Eloc, N, Is_Compile_Time_Pragma => True);
                         Cont := True;
                      else
                         Error_Msg
-                           ("\<<~!!", Eloc, Is_Compile_Time_Pragma => True);
+                           ("\<<~!!", Eloc, N, Is_Compile_Time_Pragma => True);
                      end if;
 
                   --  Error, rather than warning, or in a body, so we do not
@@ -33161,11 +33161,11 @@ package body Sem_Prag is
                   else
                      if Cont = False then
                         Error_Msg
-                           ("<<~", Eloc, Is_Compile_Time_Pragma => True);
+                           ("<<~", Eloc, N, Is_Compile_Time_Pragma => True);
                         Cont := True;
                      else
                         Error_Msg
-                           ("\<<~", Eloc, Is_Compile_Time_Pragma => True);
+                           ("\<<~", Eloc, N, Is_Compile_Time_Pragma => True);
                      end if;
                   end if;
 
-- 
cgit v1.1