[gcc r13-1619] [Ada] Ignore exceptions in task termination handlers

[gcc r13-1619] [Ada] Ignore exceptions in task termination handlers

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:fe6f256d5ba85a588493a489af1bdbe8087e368a

commit r13-1619-gfe6f256d5ba85a588493a489af1bdbe8087e368a
Author: Bob Duff <duff@adacore.com>
Date:   Mon Jun 20 13:59:03 2022 -0400

    [Ada] Ignore exceptions in task termination handlers
    
    This patch fixes a bug in which if the environment task has a specific
    termination handler, and that handler raises an exception, the handler
    is called recursively, causing infinite recursion. The RM requires such
    exceptions to be ignored.
    
    gcc/ada/
    
            * libgnarl/s-solita.adb (Task_Termination_Handler_T): Ignore all
            exceptions propagated by Specific_Handler.
            * libgnarl/s-tassta.adb, libgnarl/s-taskin.ads: Minor.

Diff:
---
 gcc/ada/libgnarl/s-solita.adb | 9 ++++++++-
 gcc/ada/libgnarl/s-taskin.ads | 2 +-
 gcc/ada/libgnarl/s-tassta.adb | 4 +---
 3 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/libgnarl/s-solita.adb b/gcc/ada/libgnarl/s-solita.adb
index 5bd66562b1d..dc0ce37cc52 100644
--- a/gcc/ada/libgnarl/s-solita.adb
+++ b/gcc/ada/libgnarl/s-solita.adb
@@ -188,7 +188,14 @@ package body System.Soft_Links.Tasking is
       --  fall-back handler applies only to the dependent tasks of the task".
 
       if Self_Id.Common.Specific_Handler /= null then
-         Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
+         begin
+            Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
+         exception
+            --  RM-C.7.3(16) requires all exceptions raised here to be ignored
+
+            when others =>
+               null;
+         end;
       end if;
    end Task_Termination_Handler_T;
 
diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads
index 2e6a0bb3bcf..b313b15391b 100644
--- a/gcc/ada/libgnarl/s-taskin.ads
+++ b/gcc/ada/libgnarl/s-taskin.ads
@@ -1168,7 +1168,7 @@ package System.Tasking is
       --
       --  Protection: Self.L. Once a task has set Self.Stage to Completing, it
       --  has exclusive access to this field.
-   end record;
+   end record; -- Ada_Task_Control_Block
 
    --------------------
    -- Initialization --
diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index d6ed99ce9ba..8ba852e6707 100644
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -1307,10 +1307,8 @@ package body System.Tasking.Stages is
       if TH /= null then
          begin
             TH.all (Cause, Self_ID, EO);
-
          exception
-
-            --  RM-C.7.3 requires all exceptions raised here to be ignored
+            --  RM-C.7.3(16) requires all exceptions raised here to be ignored
 
             when others =>
                null;