Ada: Fix crash on call to null procedure as triggering statement of select

This is really a corner case, but it exposes a couple of small issues in
Analyze_Triggering_Alternative that are worth fixing: 1) the detection of
delay and entry call statements is not robust enough and 2) there is also
a thinko in the detection of procedure call statements.

gcc/ada/
	PR ada/124179
	* sem_ch9.adb (Analyze_Triggering_Alternative): Use more robust
	test for delay and entry call statements and fix thinko in test
	for procedure call statements.

gcc/testsuite/
	* gnat.dg/asynch2.adb: New test.

diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index c90e9fbf5d4b65550eec3f9aee58ecb81e31a2c1..6536f66e4f7832fda951ce44839b159180ac02e3 100644 (file)
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -3472,22 +3472,26 @@ package body Sem_Ch9 is
    ------------------------------------
 
    procedure Analyze_Triggering_Alternative (N : Node_Id) is
-      Trigger : constant Node_Id := Triggering_Statement (N);
+      Stmt : constant Node_Id := Triggering_Statement (N);
 
    begin
       if Present (Pragmas_Before (N)) then
          Analyze_List (Pragmas_Before (N));
       end if;
 
-      Analyze (Trigger);
+      Analyze (Stmt);
 
-      if Comes_From_Source (Trigger)
-        and then Nkind (Trigger) not in N_Delay_Statement
-        and then Nkind (Trigger) /= N_Entry_Call_Statement
+      --  N_Delay_Statement may be rewritten as N_Procedure_Call_Statement,
+      --  and N_Entry_Call_Statement is parsed as N_Procedure_Call_Statement.
+
+      if Nkind (Stmt) not in N_Delay_Statement
+                           | N_Entry_Call_Statement
+        and then Nkind (Original_Node (Stmt)) not in N_Delay_Statement
+                                                   | N_Entry_Call_Statement
       then
          if Ada_Version < Ada_2005 then
             Error_Msg_N
-             ("triggering statement must be delay or entry call", Trigger);
+             ("triggering statement must be delay or entry call", Stmt);
 
          --  Ada 2005 (AI-345): If a procedure_call_statement is used for a
          --  procedure_or_entry_call, the procedure_name or procedure_prefix
@@ -3495,14 +3499,14 @@ package body Sem_Ch9 is
          --  procedure, or (a view of) a primitive subprogram of a limited
          --  interface whose first parameter is a controlling parameter.
 
-         elsif Nkind (Trigger) = N_Procedure_Call_Statement
-           and then not Is_Renamed_Entry (Entity (Name (Trigger)))
-           and then not Is_Controlling_Limited_Procedure
-                          (Entity (Name (Trigger)))
+         elsif Nkind (Stmt) /= N_Procedure_Call_Statement
+           or else (not Is_Renamed_Entry (Entity (Name (Stmt)))
+                     and then not
+                       Is_Controlling_Limited_Procedure (Entity (Name (Stmt))))
          then
             Error_Msg_N
               ("triggering statement must be procedure or entry call " &
-               "or delay statement", Trigger);
+               "or delay statement", Stmt);
          end if;
       end if;
 

diff --git a/gcc/testsuite/gnat.dg/asynch2.adb b/gcc/testsuite/gnat.dg/asynch2.adb
new file mode 100644 (file)
index 0000000..1ca3c61
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/asynch2.adb
@@ -0,0 +1,15 @@
+--  { dg-do compile }
+
+procedure Asynch2 is
+
+  procedure Proc is null;
+
+begin
+  select
+    Proc; -- { dg-error "must be procedure or entry call or delay statement" }
+  then abort
+    loop
+      delay 1.0;
+    end loop;
+  end select;
+end;