function To_Time_Span (D : Duration) return Time_Span is
begin
+ -- Note regarding AI-00432 requiring range checking on this conversion.
+ -- In almost all versions of GNAT (and all to which this version of the
+ -- Ada.Real_Time package apply), the range of Time_Span and Duration are
+ -- the same, so there is no issue of overflow.
+
return Time_Span (D);
end To_Time_Span;
-- range False .. True
-- where the occurrences of the literals must point to the
- -- corresponding definition.
+ -- corresponding definition.
R_Node := New_Node (N_Range, Stloc);
B_Node := New_Node (N_Identifier, Stloc);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- an interepretation is incompatible with the context.
-- dw Write semantic scope stack messages. Each time a scope is created
- -- or removed, a message is output (see the Sem_Ch8.New_Scope and
+ -- or removed, a message is output (see the Sem_Ch8.Push_Scope and
-- Sem_Ch8.Pop_Scope subprograms).
-- dx Force expansion on, even if no code being generated. Normally the
-- dw Prints the list of units withed by the unit currently explored
-- during the main loop of Make.Compile_Sources.
- ----------------------
- -- Get_Debug_Flag_K --
- ----------------------
-
- function Get_Debug_Flag_K return Boolean is
- begin
- return Debug_Flag_K;
- end Get_Debug_Flag_K;
-
--------------------
-- Set_Debug_Flag --
--------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
Debug_Flag_Dot_8 : Boolean := False;
Debug_Flag_Dot_9 : Boolean := False;
- function Get_Debug_Flag_K return Boolean;
- -- This function is called from C code to get the setting of the K flag
- -- (it does not work to try to access a constant object directly).
-
procedure Set_Debug_Flag (C : Character; Val : Boolean := True);
-- Where C is 0-9, A-Z, or a-z, sets the corresponding debug flag to
-- the given value. In the checks off version of debug, the call to
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
begin
- New_Scope (Standard_Standard);
+ Push_Scope (Standard_Standard);
if No (Actions (Aux)) then
Set_Actions (Aux, New_List (Decl));
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2006, AdaCore --
+-- Copyright (C) 2000-2007, 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- --
Result : Unbounded_String;
begin
- Result := Result
- & Title (Mode, "CGI complete runtime environment");
-
- Result := Result
- & Header (Mode, "CGI parameters:")
- & New_Line (Mode);
+ Result :=
+ To_Unbounded_String
+ (Title (Mode, "CGI complete runtime environment")
+ & Header (Mode, "CGI parameters:")
+ & New_Line (Mode));
for K in 1 .. Argument_Count loop
Result := Result
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Lib; use Lib;
+with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem_Ch8; use Sem_Ch8;
-----------------
function Must_Inline return Boolean is
- Scop : Entity_Id := Current_Scope;
+ Scop : Entity_Id;
Comp : Node_Id;
begin
-- Check if call is in main unit
+ Scop := Current_Scope;
+
+ -- Do not try to inline if scope is standard. This could happen, for
+ -- example, for a call to Add_Global_Declaration, and it causes
+ -- trouble to try to inline at this level.
+
+ if Scop = Standard_Standard then
+ return False;
+ end if;
+
+ -- Otherwise lookup scope stack to outer scope
+
while Scope (Scop) /= Standard_Standard
and then not Is_Child_Unit (Scop)
loop
end loop;
Comp := Parent (Scop);
-
while Nkind (Comp) /= N_Compilation_Unit loop
Comp := Parent (Comp);
end loop;
return True;
end if;
- -- Call is not in main unit. See if it's in some inlined
- -- subprogram.
+ -- Call is not in main unit. See if it's in some inlined subprogram
Scop := Current_Scope;
while Scope (Scop) /= Standard_Standard
end loop;
return False;
-
end Must_Inline;
-- Start of processing for Add_Inlined_Body
Analyzing_Inlined_Bodies := False;
if Serious_Errors_Detected = 0 then
- New_Scope (Standard_Standard);
+ Push_Scope (Standard_Standard);
J := 0;
while J <= Inlined_Bodies.Last
Error_Msg_N
("one or more inlined subprograms accessed in $!",
Comp_Unit);
- Error_Msg_Name_1 :=
+ Error_Msg_File_1 :=
Get_File_Name (Bname, Subunit => False);
Error_Msg_N ("\but file{ was not found!", Comp_Unit);
raise Unrecoverable_Error;
end if;
end if;
- New_Scope (Scop);
+ Push_Scope (Scop);
Expand_Cleanup_Actions (Decl);
End_Scope;
if Serious_Errors_Detected = 0 then
Expander_Active := (Operating_Mode = Opt.Generate_Code);
- New_Scope (Standard_Standard);
+ Push_Scope (Standard_Standard);
To_Clean := New_Elmt_List;
if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
and then (B1 = 'a' or else B1 = 'g' or else B1 = 'i' or else B1 = 's')
and then Len <= Maxlen
then
- -- When VMS is the host, it is always also the target.
+ -- When VMS is the host, it is always also the target
if Hostparm.OpenVMS or else VMS_On_Target then
Len := Len + 1;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- Line for -we
- Write_Str (" -we treat all Warnings as Errors");
+ Write_Str (" -we Treat all warnings as errors");
Write_Eol;
-- Line for -wn
- Write_Str (" -wn Normal Warning mode (cancels -we/-ws)");
+ Write_Str (" -wn Normal warning mode (cancels -we/-ws)");
Write_Eol;
-- Line for -ws
- Write_Str (" -ws Suppress all Warnings");
+ Write_Str (" -ws Suppress all warnings");
Write_Eol;
-- Line for -x
-- Source and Library search path switches
- Write_Str ("Source and Library search path switches:");
+ Write_Str ("Project, Source and Library search path switches:");
+ Write_Eol;
+
+ -- Line for -aP
+
+ Write_Str (" -aPdir Add directory dir to project search path");
Write_Eol;
-- Line for -aL
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
Bas_Opt : aliased String := "--base-file";
Bas_V : aliased String := Base_File;
No_Suf_Opt : aliased String := "-k";
+
begin
Arguments (1 .. 4) := (1 => Def_Opt'Unchecked_Access,
2 => Def_V'Unchecked_Access,
Exceptions.Raise_Exception
(Tools_Error'Identity, Dlltool_Name & " execution error.");
end if;
-
end Dlltool;
---------
-- Delete binder files
declare
Base_Name : constant String :=
- Directory_Operations.Base_Name (Ali, ".ali");
+ Directory_Operations.Base_Name (Ali, ".ali");
begin
OS_Lib.Delete_File ("b~" & Base_Name & ".ads", Success);
OS_Lib.Delete_File ("b~" & Base_Name & ".adb", Success);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
Statement_Required := False;
-- A slash following an identifier or a selected
- -- component in this situation is most likely a
- -- period (have a look at the keyboard :-)
+ -- component in this situation is most likely a period
+ -- (see location of keys on keyboard).
elsif Token = Tok_Slash
and then (Nkind (Name_Node) = N_Identifier
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
return;
-- An interesting little kludge here. If the previous token is a
- -- semicolon, then there is no way that we can legitimately need
- -- another semicolon. This could only arise in an error situation
- -- where an error has already been signalled. By simply ignoring
- -- the request for a semicolon in this case, we avoid some spurious
- -- missing semicolon messages.
+ -- semicolon, then there is no way that we can legitimately need another
+ -- semicolon. This could only arise in an error situation where an error
+ -- has already been signalled. By simply ignoring the request for a
+ -- semicolon in this case, we avoid some spurious missing semicolon
+ -- messages.
elsif Prev_Token = Tok_Semicolon then
return;
- -- If the current token is | then this is a reasonable
- -- place to suggest the possibility of a "C" confusion :-)
+ -- If the current token is | then this is a reasonable place to suggest
+ -- the possibility of a "C" confusion.
elsif Token = Tok_Vertical_Bar then
Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
Resync_Past_Semicolon;
return;
- -- Deal with pragma. If pragma is not at start of line, it is
- -- considered misplaced otherwise we treat it as a normal
- -- missing semicolong case.
+ -- Deal with pragma. If pragma is not at start of line, it is considered
+ -- misplaced otherwise we treat it as a normal missing semicolong case.
elsif Token = Tok_Pragma
and then not Token_Is_At_Start_Of_Line
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- of such a nested region. Again, like case 2, this causes us to miss
-- some nested cases, but it doesn't seen worth the effort to stack and
-- unstack the SIS information. Maybe we will reconsider this if we ever
- -- get a complaint about a missed case :-)
+ -- get a complaint about a missed case.
-- 4. We encounter a valid pragma INTERFACE or IMPORT that effectively
-- supplies the missing body. In this case we reset the entry.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
------------------------------------------------------------------------------
with Ada.Exceptions;
+with System.Exceptions;
package body System.Assertions is
procedure Raise_Assert_Failure (Msg : String) is
begin
+ System.Exceptions.Debug_Raise_Assert_Failure;
Ada.Exceptions.Raise_Exception (Assert_Failure'Identity, Msg);
end Raise_Assert_Failure;
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, 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- --
-- does not exist yet, null is returned.
function Registered_Exceptions_Count return Natural;
- -- Return the number of currently registered exceptions.
+ -- Return the number of currently registered exceptions
type Exception_Data_Array is array (Natural range <>)
of SSL.Exception_Data_Ptr;
procedure Get_Registered_Exceptions
(List : out Exception_Data_Array;
Last : out Integer);
- -- Return the list of registered exceptions.
+ -- Return the list of registered exceptions
end System.Exception_Table;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2007, 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- --
function Realloc
(Ptr : System.Address;
- Size : size_t)
- return System.Address;
+ Size : size_t) return System.Address;
-- This is the low level reallocation routine. It takes an existing
-- block address returned by a previous call to Alloc or Realloc,
-- and reallocates the block. The size can either be increased or
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
Duration'Last);
-- Max of half a year delay, needed to prevent exceptions for large delay
-- values. It seems unlikely that any test will notice this restriction,
- -- except in the case of applications setting the clock at at run time (see
+ -- except in the case of applications setting the clock at run time (see
-- s-tastim.adb). Also note that a larger value might cause problems (e.g
-- overflow, or more likely OS limitation in the primitives used). In the
-- case where half a year is too long (which occurs in high integrity mode
package System.Restrictions is
pragma Preelaborate;
+
pragma Discard_Names;
package Rident is new System.Rident;
function Current_Target_Exception return EO;
pragma Import
- (Ada, Current_Target_Exception,
- "__gnat_current_target_exception");
+ (Ada, Current_Target_Exception, "__gnat_current_target_exception");
-- Import this subprogram from the private part of Ada.Exceptions
-- First we have the access subprogram types used to establish the links.
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- for details.
type Packed_Bytes2 is new Packed_Bytes1;
- for Packed_Bytes2'Alignment use 2;
+ for Packed_Bytes2'Alignment use Integer'Min (2, Standard'Maximum_Alignment);
-- This is the type used to implement packed arrays where an alignment
- -- of 2 is helpful for maximum efficiency of the get and set routines
- -- in the corresponding library unit. This is true of all component
- -- sizes that are even but not divisible by 4 (other than 2 for which
- -- we use direct masking operations). In such cases, the clusters can
- -- be assumed to be 2-byte aligned if the array is aligned. See for
+ -- of 2 (is possible) is helpful for maximum efficiency of the get and
+ -- set routines in the corresponding library unit. This is true of all
+ -- component sizes that are even but not divisible by 4 (other than 2 for
+ -- which we use direct masking operations). In such cases, the clusters
+ -- can be assumed to be 2-byte aligned if the array is aligned. See for
-- example System.Pack_10 in file s-pack10).
type Packed_Bytes4 is new Packed_Bytes1;
for Packed_Bytes4'Alignment use Integer'Min (4, Standard'Maximum_Alignment);
-- This is the type used to implement packed arrays where an alignment
- -- of 4 is helpful for maximum efficiency of the get and set routines
- -- in the corresponding library unit. This is true of all component
- -- sizes that are divisible by 4 (other than powers of 2, which are
- -- either handled by direct masking or not packed at all). In such cases
- -- the clusters can be assumed to be 4-byte aligned if the array is
- -- aligned (see System.Pack_12 in file s-pack12 as an example).
+ -- of 4 (if possible) is helpful for maximum efficiency of the get and
+ -- set routines in the corresponding library unit. This is true of all
+ -- component sizes that are divisible by 4 (other than powers of 2, which
+ -- are either handled by direct masking or not packed at all). In such
+ -- cases the clusters can be assumed to be 4-byte aligned if the array
+ -- is aligned (see System.Pack_12 in file s-pack12 as an example).
type Bits_1 is mod 2**1;
type Bits_2 is mod 2**2;
function Shift_Left
(Value : Short_Short_Unsigned;
- Amount : Natural)
- return Short_Short_Unsigned;
+ Amount : Natural) return Short_Short_Unsigned;
function Shift_Right
(Value : Short_Short_Unsigned;
- Amount : Natural)
- return Short_Short_Unsigned;
+ Amount : Natural) return Short_Short_Unsigned;
function Shift_Right_Arithmetic
(Value : Short_Short_Unsigned;
- Amount : Natural)
- return Short_Short_Unsigned;
+ Amount : Natural) return Short_Short_Unsigned;
function Rotate_Left
(Value : Short_Short_Unsigned;
- Amount : Natural)
- return Short_Short_Unsigned;
+ Amount : Natural) return Short_Short_Unsigned;
function Rotate_Right
(Value : Short_Short_Unsigned;
- Amount : Natural)
- return Short_Short_Unsigned;
+ Amount : Natural) return Short_Short_Unsigned;
function Shift_Left
(Value : Short_Unsigned;
- Amount : Natural)
- return Short_Unsigned;
+ Amount : Natural) return Short_Unsigned;
function Shift_Right
(Value : Short_Unsigned;
- Amount : Natural)
- return Short_Unsigned;
+ Amount : Natural) return Short_Unsigned;
function Shift_Right_Arithmetic
(Value : Short_Unsigned;
- Amount : Natural)
- return Short_Unsigned;
+ Amount : Natural) return Short_Unsigned;
function Rotate_Left
(Value : Short_Unsigned;
- Amount : Natural)
- return Short_Unsigned;
+ Amount : Natural) return Short_Unsigned;
function Rotate_Right
(Value : Short_Unsigned;
- Amount : Natural)
- return Short_Unsigned;
+ Amount : Natural) return Short_Unsigned;
function Shift_Left
(Value : Unsigned;
- Amount : Natural)
- return Unsigned;
+ Amount : Natural) return Unsigned;
function Shift_Right
(Value : Unsigned;
- Amount : Natural)
- return Unsigned;
+ Amount : Natural) return Unsigned;
function Shift_Right_Arithmetic
(Value : Unsigned;
- Amount : Natural)
- return Unsigned;
+ Amount : Natural) return Unsigned;
function Rotate_Left
(Value : Unsigned;
- Amount : Natural)
- return Unsigned;
+ Amount : Natural) return Unsigned;
function Rotate_Right
(Value : Unsigned;
- Amount : Natural)
- return Unsigned;
+ Amount : Natural) return Unsigned;
function Shift_Left
(Value : Long_Unsigned;
- Amount : Natural)
- return Long_Unsigned;
+ Amount : Natural) return Long_Unsigned;
function Shift_Right
(Value : Long_Unsigned;
- Amount : Natural)
- return Long_Unsigned;
+ Amount : Natural) return Long_Unsigned;
function Shift_Right_Arithmetic
(Value : Long_Unsigned;
- Amount : Natural)
- return Long_Unsigned;
+ Amount : Natural) return Long_Unsigned;
function Rotate_Left
(Value : Long_Unsigned;
- Amount : Natural)
- return Long_Unsigned;
+ Amount : Natural) return Long_Unsigned;
function Rotate_Right
(Value : Long_Unsigned;
- Amount : Natural)
- return Long_Unsigned;
+ Amount : Natural) return Long_Unsigned;
function Shift_Left
(Value : Long_Long_Unsigned;
- Amount : Natural)
- return Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Unsigned;
function Shift_Right
(Value : Long_Long_Unsigned;
- Amount : Natural)
- return Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Unsigned;
function Shift_Right_Arithmetic
(Value : Long_Long_Unsigned;
- Amount : Natural)
- return Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Unsigned;
function Rotate_Left
(Value : Long_Long_Unsigned;
- Amount : Natural)
- return Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Unsigned;
function Rotate_Right
(Value : Long_Long_Unsigned;
- Amount : Natural)
- return Long_Long_Unsigned;
+ Amount : Natural) return Long_Long_Unsigned;
pragma Import (Intrinsic, Shift_Left);
pragma Import (Intrinsic, Shift_Right);
-- --
------------------------------------------------------------------------------
-with System.Pure_Exceptions; use System.Pure_Exceptions;
-
package body System.WCh_JIS is
type Byte is mod 256;
-- bit is set in both bytes.
if JIS2 < 16#80# then
- Raise_Exception (CE, "invalid small Katakana character");
+ raise Constraint_Error;
end if;
EUC1 := Character'Val (EUC_Hankaku_Kana);
-- a valid character for representation in EUC form.
elsif JIS1 > 16#7F# or else JIS2 > 16#7F# then
- Raise_Exception (CE, "wide character value out of EUC range");
+ raise Constraint_Error;
-- Result is just the two characters with upper bits set
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- S is the entity of a scope. This function determines if this scope
-- is currently open (i.e. it appears somewhere in the scope stack).
- procedure New_Scope (S : Entity_Id);
+ procedure Push_Scope (S : Entity_Id);
-- Make new scope stack entry, pushing S, the entity for a scope
-- onto the top of the scope table. The current setting of the scope
-- suppress flags is saved for restoration on exit.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
with Einfo; use Einfo;
with Elists; use Elists;
with Lib; use Lib;
-with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
+with Opt; use Opt;
with Restrict; use Restrict;
with Rident; use Rident;
with Sinfo; use Sinfo;
Exception_Choices : List_Id;
Statements : List_Id) return Node_Id
is
- Handler : constant Node_Id :=
- Make_Exception_Handler
- (Sloc, Choice_Parameter, Exception_Choices, Statements);
+ Handler : Node_Id;
+ Loc : Source_Ptr;
+
begin
+ -- Set the source location only when debugging the expanded code
+
+ -- When debugging the source code directly, we do not want the compiler
+ -- to associate this implicit exception handler with any specific source
+ -- line, because it can potentially confuse the debugger. The most
+ -- damaging situation would arise when the debugger tries to insert a
+ -- breakpoint at a certain line. If the code of the associated implicit
+ -- exception handler is generated before the code of that line, then the
+ -- debugger will end up inserting the breakpoint inside the exception
+ -- handler, rather than the code the user intended to break on. As a
+ -- result, it is likely that the program will not hit the breakpoint
+ -- as expected.
+
+ if Debug_Generated_Code then
+ Loc := Sloc;
+ else
+ Loc := No_Location;
+ end if;
+
+ Handler :=
+ Make_Exception_Handler
+ (Loc, Choice_Parameter, Exception_Choices, Statements);
Set_Local_Raise_Statements (Handler, No_Elist);
return Handler;
end Make_Implicit_Exception_Handler;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- This package contains various utility procedures to assist in
-- building specific types of tree nodes.
+with Namet; use Namet;
with Types; use Types;
package Tbuild is
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
procedure Write_Non_Compressed_Sequence;
-- Output currently collected sequence of non-compressible data
+ -----------------------------------
+ -- Write_Non_Compressed_Sequence --
+ -----------------------------------
+
procedure Write_Non_Compressed_Sequence is
begin
if NC > 0 then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
-- Print Etype field if present (printing of this field for entities
-- is handled by the Print_Entity_Info procedure).
- if Nkind (N) in N_Has_Etype
- and then Present (Etype (N))
- then
+ if Nkind (N) in N_Has_Etype and then Present (Etype (N)) then
Print_Str (Prefix_Str_Char);
Print_Str ("Etype = ");
Print_Node_Ref (Etype (N));
projects / thirdparty / gcc.git / commitdiff
