From 528576de0bd3bf7154952d9b5e7ced2b4ed7f038 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 22 Jan 2020 06:43:54 -0500 Subject: [PATCH] [Ada] New procedure Register_Global_Unhandled_Action 2020-06-04 Arnaud Charlet gcc/ada/ * libgnat/a-exextr.adb (Global_Unhandled_Action): New global variable. (Notify_Exception): Take into account Global_Unhandled_Action and fix latent race condition. (Exception_Action): Mark Favor_Top_Level so that variables can be atomic. (Global_Action): Mark atomic to remove the need for a lock. * libgnat/g-excact.ads, libgnat/g-excact.adb (Register_Global_Unhandled_Action): New procedure. (Register_Global_Action): Remove lock. * libgnat/s-stalib.ads (Raise_Action): Mark Favor_Top_Level to be compatible with Exception_Action. * sem_warn.adb (Warn_On_Unreferenced_Entity): Fix logic wrt Volatile entities and entities with an address clause: the code did not match the comment/intent. --- gcc/ada/libgnat/a-exextr.adb | 24 ++++++++++++++++++++++-- gcc/ada/libgnat/g-excact.adb | 25 +++++++++++++++++++++---- gcc/ada/libgnat/g-excact.ads | 5 +++++ gcc/ada/libgnat/s-stalib.ads | 1 + gcc/ada/sem_warn.adb | 7 +++---- 5 files changed, 52 insertions(+), 10 deletions(-) diff --git a/gcc/ada/libgnat/a-exextr.adb b/gcc/ada/libgnat/a-exextr.adb index 87890875e47..da66873d02d 100644 --- a/gcc/ada/libgnat/a-exextr.adb +++ b/gcc/ada/libgnat/a-exextr.adb @@ -43,12 +43,23 @@ package body Exception_Traces is -- Convenient shortcut type Exception_Action is access procedure (E : Exception_Occurrence); + pragma Favor_Top_Level (Exception_Action); + Global_Action : Exception_Action := null; + pragma Atomic (Global_Action); pragma Export (Ada, Global_Action, "__gnat_exception_actions_global_action"); -- Global action, executed whenever an exception is raised. Changing the -- export name must be coordinated with code in g-excact.adb. + Global_Unhandled_Action : Exception_Action := null; + pragma Atomic (Global_Unhandled_Action); + pragma Export + (Ada, Global_Unhandled_Action, + "__gnat_exception_actions_global_unhandled_action"); + -- Global action, executed whenever an unhandled exception is raised. + -- Changing the export name must be coordinated with code in g-excact.adb. + Raise_Hook_Initialized : Boolean := False; pragma Export (Ada, Raise_Hook_Initialized, "__gnat_exception_actions_initialized"); @@ -77,6 +88,11 @@ package body Exception_Traces is ---------------------- procedure Notify_Exception (Excep : EOA; Is_Unhandled : Boolean) is + -- Save actions locally to avoid any race condition that would + -- reset them to null. + Action : constant Exception_Action := Global_Action; + Unhandled_Action : constant Exception_Action := Global_Unhandled_Action; + begin -- Output the exception information required by the Exception_Trace -- configuration. Take care not to output information about internal @@ -119,8 +135,12 @@ package body Exception_Traces is To_Action (Exception_Data_Ptr (Excep.Id).Raise_Hook) (Excep.all); end if; - if Global_Action /= null then - Global_Action (Excep.all); + if Is_Unhandled and Unhandled_Action /= null then + Unhandled_Action (Excep.all); + end if; + + if Action /= null then + Action (Excep.all); end if; end Notify_Exception; diff --git a/gcc/ada/libgnat/g-excact.adb b/gcc/ada/libgnat/g-excact.adb index 39eb5a5c518..202d9e20ca1 100644 --- a/gcc/ada/libgnat/g-excact.adb +++ b/gcc/ada/libgnat/g-excact.adb @@ -38,9 +38,19 @@ with System.Exception_Table; use System.Exception_Table; package body GNAT.Exception_Actions is Global_Action : Exception_Action; - pragma Import (C, Global_Action, "__gnat_exception_actions_global_action"); + pragma Import + (Ada, Global_Action, "__gnat_exception_actions_global_action"); + pragma Atomic (Global_Action); -- Imported from Ada.Exceptions. Any change in the external name needs to - -- be coordinated with a-except.adb + -- be coordinated with a-exextr.adb. + + Global_Unhandled_Action : Exception_Action; + pragma Import + (Ada, Global_Unhandled_Action, + "__gnat_exception_actions_global_unhandled_action"); + pragma Atomic (Global_Unhandled_Action); + -- Imported from Ada.Exceptions. Any change in the external name needs to + -- be coordinated with a-exextr.adb. Raise_Hook_Initialized : Boolean; pragma Import @@ -61,11 +71,18 @@ package body GNAT.Exception_Actions is procedure Register_Global_Action (Action : Exception_Action) is begin - Lock_Task.all; Global_Action := Action; - Unlock_Task.all; end Register_Global_Action; + -------------------------------------- + -- Register_Global_Unhandled_Action -- + -------------------------------------- + + procedure Register_Global_Unhandled_Action (Action : Exception_Action) is + begin + Global_Unhandled_Action := Action; + end Register_Global_Unhandled_Action; + ------------------------ -- Register_Id_Action -- ------------------------ diff --git a/gcc/ada/libgnat/g-excact.ads b/gcc/ada/libgnat/g-excact.ads index 2aa0a7e8781..c38f6a03761 100644 --- a/gcc/ada/libgnat/g-excact.ads +++ b/gcc/ada/libgnat/g-excact.ads @@ -57,6 +57,7 @@ package GNAT.Exception_Actions is type Exception_Action is access procedure (Occurrence : Exception_Occurrence); + pragma Favor_Top_Level (Exception_Action); -- General callback type whenever an exception is raised. The callback -- procedure must not propagate an exception (execution of the program -- is erroneous if such an exception is propagated). @@ -69,6 +70,10 @@ package GNAT.Exception_Actions is -- Action is called before the exception is propagated to user's code. -- If Action is null, this will in effect cancel all exception actions. + procedure Register_Global_Unhandled_Action (Action : Exception_Action); + -- Similar to Register_Global_Action, called on unhandled exceptions + -- only. + procedure Register_Id_Action (Id : Exception_Id; Action : Exception_Action); diff --git a/gcc/ada/libgnat/s-stalib.ads b/gcc/ada/libgnat/s-stalib.ads index 0b38849361e..5fbedae2e36 100644 --- a/gcc/ada/libgnat/s-stalib.ads +++ b/gcc/ada/libgnat/s-stalib.ads @@ -81,6 +81,7 @@ package System.Standard_Library is ------------------------------------- type Raise_Action is access procedure; + pragma Favor_Top_Level (Raise_Action); -- A pointer to a procedure used in the Raise_Hook field type Exception_Data; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 6f91dc14362..0158adcd320 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -4330,11 +4330,10 @@ package body Sem_Warn is -- the message if the variable is volatile, has an address -- clause, is aliased, or is a renaming, or is imported. - if Referenced_As_LHS_Check_Spec (E) - and then No (Address_Clause (E)) - and then not Is_Volatile (E) - then + if Referenced_As_LHS_Check_Spec (E) then if Warn_On_Modified_Unread + and then No (Address_Clause (E)) + and then not Is_Volatile (E) and then not Is_Imported (E) and then not Is_Aliased (E) and then No (Renamed_Object (E)) -- 2.30.2