diff options
Diffstat (limited to 'gcc/ada/g-exctra.adb')
| -rw-r--r-- | gcc/ada/g-exctra.adb | 91 |
1 files changed, 5 insertions, 86 deletions
diff --git a/gcc/ada/g-exctra.adb b/gcc/ada/g-exctra.adb index 1ac24ce..8844fcf 100644 --- a/gcc/ada/g-exctra.adb +++ b/gcc/ada/g-exctra.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2010, AdaCore -- +-- Copyright (C) 2000-2014, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,89 +29,8 @@ -- -- ------------------------------------------------------------------------------ -with System.Standard_Library; use System.Standard_Library; -with System.Soft_Links; use System.Soft_Links; +-- This package does not require a body, since it is a package renaming. We +-- provide a dummy file containing a No_Body pragma so that previous versions +-- of the body (which did exist) will not interfere. -package body GNAT.Exception_Traces is - - -- Calling the decorator directly from where it is needed would require - -- introducing nasty dependencies upon the spec of this package (typically - -- in a-except.adb). We also have to deal with the fact that the traceback - -- array within an exception occurrence and the one the decorator shall - -- accept are of different types. These are two reasons for which a wrapper - -- with a System.Address argument is indeed used to call the decorator - -- provided by the user of this package. This wrapper is called via a - -- soft-link, which either is null when no decorator is in place or "points - -- to" the following function otherwise. - - function Decorator_Wrapper - (Traceback : System.Address; - Len : Natural) return String; - -- The wrapper to be called when a decorator is in place for exception - -- backtraces. - -- - -- Traceback is the address of the call chain array as stored in the - -- exception occurrence and Len is the number of significant addresses - -- contained in this array. - - Current_Decorator : Traceback_Decorator := null; - -- The decorator to be called by the wrapper when it is not null, as set - -- by Set_Trace_Decorator. When this access is null, the wrapper is null - -- also and shall then not be called. - - ----------------------- - -- Decorator_Wrapper -- - ----------------------- - - function Decorator_Wrapper - (Traceback : System.Address; - Len : Natural) return String - is - Decorator_Traceback : Tracebacks_Array (1 .. Len); - for Decorator_Traceback'Address use Traceback; - - -- Handle the "transition" from the array stored in the exception - -- occurrence to the array expected by the decorator. - - pragma Import (Ada, Decorator_Traceback); - - begin - return Current_Decorator.all (Decorator_Traceback); - end Decorator_Wrapper; - - ------------------------- - -- Set_Trace_Decorator -- - ------------------------- - - procedure Set_Trace_Decorator (Decorator : Traceback_Decorator) is - begin - Current_Decorator := Decorator; - Traceback_Decorator_Wrapper := - (if Current_Decorator /= null - then Decorator_Wrapper'Access else null); - end Set_Trace_Decorator; - - --------------- - -- Trace_Off -- - --------------- - - procedure Trace_Off is - begin - Exception_Trace := RM_Convention; - end Trace_Off; - - -------------- - -- Trace_On -- - -------------- - - procedure Trace_On (Kind : Trace_Kind) is - begin - case Kind is - when Every_Raise => - Exception_Trace := Every_Raise; - when Unhandled_Raise => - Exception_Trace := Unhandled_Raise; - end case; - end Trace_On; - -end GNAT.Exception_Traces; +pragma No_Body; |