[multiple changes]
2011-08-29 Tristan Gingold <gingold@adacore.com> * s-excdeb.ads, s-excdeb.adb: New files, created from s-except. * rtsfind.ads (RTU_Id): Replaces System_Exceptions by System_Exceptions_Debug (RE_Unit_Table): Search RE_Local_Raise in System_Exceptions_Debug * a-except.adb: With and use System.Exceptions_Debug instead of System.Exceptions. * a-except-2005.adb: Likewise. * s-assert.adb: Likewise. * s-except.adb, s-except.ads: Move debugging hooks to s-excdeb. * Makefile.rtl: Add s-excdeb. Adjust compilation rule. * gcc-interfaces/Makefile.in, gcc-interface/Make-lang.in: Add s-excdeb. Update dependencies. (GNATRTL_LINEARALGEBRA_OBJS): Remove a-nlrear.o a-nurear.o a-nllrar.o as these no longer need external libraries. 2011-08-29 Ed Schonberg <schonberg@adacore.com> * sem_res.adb (Resolve_Op_Expon): Additional check to reject an exponentiation operator on universal values in a context that requires a fixed-point type. 2011-08-29 Tristan Gingold <gingold@adacore.com> * raise-gcc.c (personnality_routine): Fix thinko. Set Ada occurrence before calling notify_handled_exception. * a-exextr.adb: Fix comment. From-SVN: r178221
This commit is contained in:
parent
b254da66e7
commit
4d79254934
@ -1,3 +1,32 @@
|
||||
2011-08-29 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* s-excdeb.ads, s-excdeb.adb: New files, created from s-except.
|
||||
* rtsfind.ads (RTU_Id): Replaces System_Exceptions by
|
||||
System_Exceptions_Debug
|
||||
(RE_Unit_Table): Search RE_Local_Raise in System_Exceptions_Debug
|
||||
* a-except.adb: With and use System.Exceptions_Debug instead of
|
||||
System.Exceptions.
|
||||
* a-except-2005.adb: Likewise.
|
||||
* s-assert.adb: Likewise.
|
||||
* s-except.adb, s-except.ads: Move debugging hooks to s-excdeb.
|
||||
* Makefile.rtl: Add s-excdeb. Adjust compilation rule.
|
||||
* gcc-interfaces/Makefile.in, gcc-interface/Make-lang.in: Add
|
||||
s-excdeb. Update dependencies.
|
||||
(GNATRTL_LINEARALGEBRA_OBJS): Remove a-nlrear.o a-nurear.o a-nllrar.o
|
||||
as these no longer need external libraries.
|
||||
|
||||
2011-08-29 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_res.adb (Resolve_Op_Expon): Additional check to reject an
|
||||
exponentiation operator on universal values in a context that requires
|
||||
a fixed-point type.
|
||||
|
||||
2011-08-29 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* raise-gcc.c (personnality_routine): Fix thinko. Set Ada occurrence
|
||||
before calling notify_handled_exception.
|
||||
* a-exextr.adb: Fix comment.
|
||||
|
||||
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_Allocator_Expression): Add code to set attribute
|
||||
|
@ -479,6 +479,7 @@ GNATRTL_NONTASKING_OBJS= \
|
||||
s-crtrun$(objext) \
|
||||
s-direio$(objext) \
|
||||
s-dsaser$(objext) \
|
||||
s-excdeb$(objext) \
|
||||
s-except$(objext) \
|
||||
s-exctab$(objext) \
|
||||
s-exnint$(objext) \
|
||||
|
@ -46,6 +46,7 @@ pragma Polling (Off);
|
||||
|
||||
with System; use System;
|
||||
with System.Exceptions; use System.Exceptions;
|
||||
with System.Exceptions_Debug; use System.Exceptions_Debug;
|
||||
with System.Standard_Library; use System.Standard_Library;
|
||||
with System.Soft_Links; use System.Soft_Links;
|
||||
with System.WCh_Con; use System.WCh_Con;
|
||||
|
@ -50,7 +50,7 @@ pragma Polling (Off);
|
||||
-- elaboration circularities with System.Exception_Tables.
|
||||
|
||||
with System; use System;
|
||||
with System.Exceptions; use System.Exceptions;
|
||||
with System.Exceptions_Debug; use System.Exceptions_Debug;
|
||||
with System.Standard_Library; use System.Standard_Library;
|
||||
with System.Soft_Links; use System.Soft_Links;
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -93,11 +93,6 @@ package body Exception_Traces is
|
||||
-- configuration. Take care not to output information about internal
|
||||
-- exceptions.
|
||||
|
||||
-- ??? In the Front-End ZCX case, the traceback entries we have at this
|
||||
-- point only include the ones we stored while walking up the stack *up
|
||||
-- to the handler*. All the frames above the subprogram in which the
|
||||
-- handler is found are missing.
|
||||
|
||||
if not Excep.Id.Not_Handled_By_Others
|
||||
and then
|
||||
(Exception_Trace = Every_Raise
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -2263,8 +2263,8 @@ LIBGNAT_OBJS = adadecode.o adaint.o argv.o cio.o cstreams.o ctrl_c.o \
|
||||
|
||||
include $(fsrcdir)/ada/Makefile.rtl
|
||||
|
||||
GNATRTL_LINEARALGEBRA_OBJS = a-nlcoar.o a-nllcar.o a-nllrar.o a-nlrear.o \
|
||||
a-nucoar.o a-nurear.o i-forbla.o i-forlap.o s-gearop.o
|
||||
GNATRTL_LINEARALGEBRA_OBJS = a-nlcoar.o a-nllcar.o \
|
||||
a-nucoar.o i-forbla.o i-forlap.o s-gearop.o
|
||||
|
||||
GNATRTL_OBJS = $(GNATRTL_NONTASKING_OBJS) $(GNATRTL_TASKING_OBJS) \
|
||||
$(GNATRTL_LINEARALGEBRA_OBJS) g-trasym.o memtrack.o
|
||||
@ -2774,11 +2774,11 @@ a-except.o : a-except.adb a-except.ads
|
||||
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O1 -fno-inline \
|
||||
$(NO_REORDER_ADAFLAGS) $(ADA_INCLUDES) $< $(OUTPUT_OPTION)
|
||||
|
||||
# compile s-except.o without optimization and with debug info to let the
|
||||
# compile s-excdeb.o without optimization and with debug info to let the
|
||||
# debugger set breakpoints and inspect subprogram parameters on exception
|
||||
# related events.
|
||||
|
||||
s-except.o : s-except.adb s-except.ads
|
||||
s-excdeb.o : s-excdeb.adb s-excdeb.ads s-except.ads
|
||||
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) \
|
||||
$< $(OUTPUT_OPTION)
|
||||
|
||||
|
@ -1149,7 +1149,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg,
|
||||
else
|
||||
{
|
||||
/* Trigger the appropriate notification routines before the second
|
||||
phase starts, which ensures the stack is still intact. */
|
||||
phase starts, which ensures the stack is still intact.
|
||||
First, setup the Ada occurrence. */
|
||||
__gnat_setup_current_excep (uw_exception);
|
||||
__gnat_notify_handled_exception ();
|
||||
|
||||
return _URC_HANDLER_FOUND;
|
||||
|
@ -226,7 +226,7 @@ package Rtsfind is
|
||||
System_DSA_Services,
|
||||
System_DSA_Types,
|
||||
System_Exception_Table,
|
||||
System_Exceptions,
|
||||
System_Exceptions_Debug,
|
||||
System_Exn_Int,
|
||||
System_Exn_LLF,
|
||||
System_Exn_LLI,
|
||||
@ -753,7 +753,7 @@ package Rtsfind is
|
||||
|
||||
RE_Register_Exception, -- System.Exception_Table
|
||||
|
||||
RE_Local_Raise, -- System.Exceptions
|
||||
RE_Local_Raise, -- System.Exceptions_Debug
|
||||
|
||||
RE_Exn_Integer, -- System.Exn_Int
|
||||
|
||||
@ -1940,7 +1940,7 @@ package Rtsfind is
|
||||
|
||||
RE_Register_Exception => System_Exception_Table,
|
||||
|
||||
RE_Local_Raise => System_Exceptions,
|
||||
RE_Local_Raise => System_Exceptions_Debug,
|
||||
|
||||
RE_Exn_Integer => System_Exn_Int,
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -32,7 +32,7 @@
|
||||
pragma Compiler_Unit;
|
||||
|
||||
with Ada.Exceptions;
|
||||
with System.Exceptions;
|
||||
with System.Exceptions_Debug;
|
||||
|
||||
package body System.Assertions is
|
||||
|
||||
@ -42,7 +42,7 @@ package body System.Assertions is
|
||||
|
||||
procedure Raise_Assert_Failure (Msg : String) is
|
||||
begin
|
||||
System.Exceptions.Debug_Raise_Assert_Failure;
|
||||
System.Exceptions_Debug.Debug_Raise_Assert_Failure;
|
||||
Ada.Exceptions.Raise_Exception (Assert_Failure'Identity, Msg);
|
||||
end Raise_Assert_Failure;
|
||||
|
||||
|
75
gcc/ada/s-excdeb.adb
Normal file
75
gcc/ada/s-excdeb.adb
Normal file
@ -0,0 +1,75 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E X C E P T I O N S _ D E B U G --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
pragma Compiler_Unit;
|
||||
|
||||
package body System.Exceptions_Debug is
|
||||
|
||||
---------------------------
|
||||
-- Debug_Raise_Exception --
|
||||
---------------------------
|
||||
|
||||
procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr) is
|
||||
pragma Inspection_Point (E);
|
||||
begin
|
||||
null;
|
||||
end Debug_Raise_Exception;
|
||||
|
||||
-------------------------------
|
||||
-- Debug_unhandled_Exception --
|
||||
-------------------------------
|
||||
|
||||
procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr) is
|
||||
pragma Inspection_Point (E);
|
||||
begin
|
||||
null;
|
||||
end Debug_Unhandled_Exception;
|
||||
|
||||
--------------------------------
|
||||
-- Debug_Raise_Assert_Failure --
|
||||
--------------------------------
|
||||
|
||||
procedure Debug_Raise_Assert_Failure is
|
||||
begin
|
||||
null;
|
||||
end Debug_Raise_Assert_Failure;
|
||||
|
||||
-----------------
|
||||
-- Local_Raise --
|
||||
-----------------
|
||||
|
||||
procedure Local_Raise (Excep : System.Address) is
|
||||
pragma Warnings (Off, Excep);
|
||||
begin
|
||||
return;
|
||||
end Local_Raise;
|
||||
|
||||
end System.Exceptions_Debug;
|
77
gcc/ada/s-excdeb.ads
Normal file
77
gcc/ada/s-excdeb.ads
Normal file
@ -0,0 +1,77 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT COMPILER COMPONENTS --
|
||||
-- --
|
||||
-- S Y S T E M . E X C E P T I O N S _ D E B U G --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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- --
|
||||
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains internal routines used as debugger helpers.
|
||||
-- It should be compiled without optimization to let debuggers inspect
|
||||
-- parameter values reliably from breakpoints on the routines.
|
||||
|
||||
pragma Compiler_Unit;
|
||||
|
||||
with System.Standard_Library;
|
||||
|
||||
package System.Exceptions_Debug is
|
||||
|
||||
pragma Preelaborate_05;
|
||||
-- To let Ada.Exceptions "with" us and let us "with" Standard_Library
|
||||
|
||||
package SSL renames System.Standard_Library;
|
||||
-- To let some of the hooks below have formal parameters typed in
|
||||
-- accordance with what GDB expects.
|
||||
|
||||
procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr);
|
||||
pragma Export
|
||||
(Ada, Debug_Raise_Exception, "__gnat_debug_raise_exception");
|
||||
-- Hook called at a "raise" point for an exception E, when it is
|
||||
-- just about to be propagated.
|
||||
|
||||
procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr);
|
||||
pragma Export
|
||||
(Ada, Debug_Unhandled_Exception, "__gnat_unhandled_exception");
|
||||
-- Hook called during the propagation process of an exception E, as soon
|
||||
-- as it is known to be unhandled.
|
||||
|
||||
procedure Debug_Raise_Assert_Failure;
|
||||
pragma Export
|
||||
(Ada, Debug_Raise_Assert_Failure, "__gnat_debug_raise_assert_failure");
|
||||
-- Hook called when an assertion failed. This is used by the debugger to
|
||||
-- intercept assertion failures, and treat them specially.
|
||||
|
||||
procedure Local_Raise (Excep : System.Address);
|
||||
pragma Export (Ada, Local_Raise);
|
||||
-- This is a dummy routine, used only by the debugger for the purpose of
|
||||
-- logging local raise statements that were transformed into a direct goto
|
||||
-- to the handler code. The compiler in this case generates:
|
||||
--
|
||||
-- Local_Raise (exception_data'address);
|
||||
-- goto Handler
|
||||
--
|
||||
-- The argument is the address of the exception data
|
||||
end System.Exceptions_Debug;
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2006-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- 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,47 +29,4 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
pragma Compiler_Unit;
|
||||
|
||||
package body System.Exceptions is
|
||||
|
||||
---------------------------
|
||||
-- Debug_Raise_Exception --
|
||||
---------------------------
|
||||
|
||||
procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr) is
|
||||
pragma Inspection_Point (E);
|
||||
begin
|
||||
null;
|
||||
end Debug_Raise_Exception;
|
||||
|
||||
-------------------------------
|
||||
-- Debug_unhandled_Exception --
|
||||
-------------------------------
|
||||
|
||||
procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr) is
|
||||
pragma Inspection_Point (E);
|
||||
begin
|
||||
null;
|
||||
end Debug_Unhandled_Exception;
|
||||
|
||||
--------------------------------
|
||||
-- Debug_Raise_Assert_Failure --
|
||||
--------------------------------
|
||||
|
||||
procedure Debug_Raise_Assert_Failure is
|
||||
begin
|
||||
null;
|
||||
end Debug_Raise_Assert_Failure;
|
||||
|
||||
-----------------
|
||||
-- Local_Raise --
|
||||
-----------------
|
||||
|
||||
procedure Local_Raise (Excep : System.Address) is
|
||||
pragma Warnings (Off, Excep);
|
||||
begin
|
||||
return;
|
||||
end Local_Raise;
|
||||
|
||||
end System.Exceptions;
|
||||
pragma No_Body;
|
||||
|
@ -29,14 +29,8 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains internal routines used as debugger helpers.
|
||||
-- It should be compiled without optimization to let debuggers inspect
|
||||
-- parameter values reliably from breakpoints on the routines.
|
||||
|
||||
pragma Compiler_Unit;
|
||||
|
||||
with System.Standard_Library;
|
||||
|
||||
package System.Exceptions is
|
||||
|
||||
pragma Preelaborate_05;
|
||||
@ -45,39 +39,6 @@ package System.Exceptions is
|
||||
ZCX_By_Default : constant Boolean;
|
||||
-- Visible copy to allow Ada.Exceptions to know the exception model.
|
||||
|
||||
package SSL renames System.Standard_Library;
|
||||
-- To let some of the hooks below have formal parameters typed in
|
||||
-- accordance with what GDB expects.
|
||||
|
||||
procedure Debug_Raise_Exception (E : SSL.Exception_Data_Ptr);
|
||||
pragma Export
|
||||
(Ada, Debug_Raise_Exception, "__gnat_debug_raise_exception");
|
||||
-- Hook called at a "raise" point for an exception E, when it is
|
||||
-- just about to be propagated.
|
||||
|
||||
procedure Debug_Unhandled_Exception (E : SSL.Exception_Data_Ptr);
|
||||
pragma Export
|
||||
(Ada, Debug_Unhandled_Exception, "__gnat_unhandled_exception");
|
||||
-- Hook called during the propagation process of an exception E, as soon
|
||||
-- as it is known to be unhandled.
|
||||
|
||||
procedure Debug_Raise_Assert_Failure;
|
||||
pragma Export
|
||||
(Ada, Debug_Raise_Assert_Failure, "__gnat_debug_raise_assert_failure");
|
||||
-- Hook called when an assertion failed. This is used by the debugger to
|
||||
-- intercept assertion failures, and treat them specially.
|
||||
|
||||
procedure Local_Raise (Excep : System.Address);
|
||||
pragma Export (Ada, Local_Raise);
|
||||
-- This is a dummy routine, used only by the debugger for the purpose of
|
||||
-- logging local raise statements that were transformed into a direct goto
|
||||
-- to the handler code. The compiler in this case generates:
|
||||
--
|
||||
-- Local_Raise (exception_data'address);
|
||||
-- goto Handler
|
||||
--
|
||||
-- The argument is the address of the exception data
|
||||
|
||||
private
|
||||
ZCX_By_Default : constant Boolean := System.ZCX_By_Default;
|
||||
|
||||
|
@ -7839,6 +7839,14 @@ package body Sem_Res is
|
||||
if Is_Fixed_Point_Type (Typ) and then Comes_From_Source (N) then
|
||||
Error_Msg_N ("exponentiation not available for fixed point", N);
|
||||
return;
|
||||
|
||||
elsif Nkind (Parent (N)) in N_Op
|
||||
and then Is_Fixed_Point_Type (Etype (Parent (N)))
|
||||
and then Etype (N) = Universal_Real
|
||||
and then Comes_From_Source (N)
|
||||
then
|
||||
Error_Msg_N ("exponentiation not available for fixed point", N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Comes_From_Source (N)
|
||||
|
Loading…
Reference in New Issue
Block a user