diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/libgnat/a-exextr.adb | 24 | ||||
| -rw-r--r-- | gcc/ada/libgnat/g-excact.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/libgnat/g-excact.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-stalib.ads | 1 | ||||
| -rw-r--r-- | 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 8789087..da66873 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 39eb5a5..202d9e2 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 2aa0a7e..c38f6a0 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 0b38849..5fbedae 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 6f91dc1..0158adc 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)) |