From fe6f256d5ba85a588493a489af1bdbe8087e368a Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Mon, 20 Jun 2022 13:59:03 -0400 Subject: [PATCH] [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. --- 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 5bd6656..dc0ce37 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 2e6a0bb..b313b15 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 d6ed99c..8ba852e 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; -- 2.7.4