-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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 2, or (at your option) any later ver- --
+-- 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
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 Sem_Aux; use Sem_Aux;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
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;
return LS;
end Make_Linker_Section_Pragma;
+ -----------------
+ -- Make_Pragma --
+ -----------------
+
+ function Make_Pragma
+ (Sloc : Source_Ptr;
+ Chars : Name_Id;
+ Pragma_Argument_Associations : List_Id := No_List;
+ Debug_Statement : Node_Id := Empty) return Node_Id
+ is
+ begin
+ return
+ Make_Pragma (Sloc,
+ Pragma_Argument_Associations => Pragma_Argument_Associations,
+ Debug_Statement => Debug_Statement,
+ Pragma_Identifier => Make_Identifier (Sloc, Chars));
+ end Make_Pragma;
+
---------------------------------
-- Make_Raise_Constraint_Error --
---------------------------------
Strval => End_String);
end Make_String_Literal;
+ --------------------
+ -- Make_Temporary --
+ --------------------
+
+ function Make_Temporary
+ (Loc : Source_Ptr;
+ Id : Character;
+ Related_Node : Node_Id := Empty) return Node_Id
+ is
+ Temp : constant Node_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name (Id));
+ begin
+ Set_Related_Expression (Temp, Related_Node);
+ return Temp;
+ end Make_Temporary;
+
---------------------------
-- Make_Unsuppress_Block --
---------------------------
Get_Name_String (Related_Id);
if Prefix /= ' ' then
- pragma Assert (Is_OK_Internal_Letter (Prefix));
+ pragma Assert (Is_OK_Internal_Letter (Prefix) or else Prefix = '_');
for J in reverse 1 .. Name_Len loop
Name_Buffer (J + 1) := Name_Buffer (J);
if Suffix /= ' ' then
pragma Assert (Is_OK_Internal_Letter (Suffix));
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := Suffix;
+ Add_Char_To_Name_Buffer (Suffix);
end if;
if Suffix_Index /= 0 then
is
begin
Get_Name_String (Related_Id);
- Name_Len := Name_Len + 1;
- Name_Buffer (Name_Len) := '_';
- Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
- Name_Len := Name_Len + Suffix'Length;
+ Add_Char_To_Name_Buffer ('_');
+ Add_Str_To_Name_Buffer (Suffix);
return Name_Find;
end New_Suffixed_Name;