2007-04-06 Robert Dewar <dewar@adacore.com>

	* a-except.adb, a-except.ads, a-except-2005.ads, a-except-2005.adb
	(Local_Raise): New dummy procedure called when a raise is converted
	to a local goto. Used for debugger to detect that the exception
	is raised.

	* debug.adb: Document new d.g flag (expand local raise statements to
	gotos even if pragma Restriction (No_Exception_Propagation) is not set)

	* exp_sel.adb: Use Make_Implicit_Exception_Handler

	* exp_ch11.adb (Expand_Exception_Handlers): Use new flag -gnatw.x to
	suppress warnings for unused handlers.
	(Warn_If_No_Propagation):  Use new flag -gnatw.x to suppress
	warnings for raise statements not handled locally.
	(Get_RT_Exception_Entity): New function
	(Get_Local_Call_Entity): New function
	(Find_Local_Handler): New function
	(Warn_If_No_Propagation): New procedure
	(Expand_At_End_Handler): Call Make_Implicit_Handler
	(Expand_Exception_Handlers): Major additions to deal with local handlers
	(Expand_N_Raise_Constraint_Error, Expand_N_Raise_Program_Error,
	Expand_N_Raise_Storage_Error, (Expand_N_Raise_Statement): Add handling
	for local raise

	* exp_ch11.ads (Get_RT_Exception_Entity): New function
	(Get_Local_Call_Entity): New function

	* gnatbind.adb (Restriction_List): Add No_Exception_Propagation to list
	of restrictions that the binder will never suggest adding.

	* par-ch11.adb (P_Exception_Handler): Set Local_Raise_Statements field
	to No_Elist.

	* restrict.adb (Check_Restricted_Unit): GNAT.Current_Exception may not
	be with'ed in the presence of pragma Restriction
	(No_Exception_Propagation).

	* sem.adb (Analyze): Add entries for N_Push and N_Pop nodes

	* sem_ch11.adb (Analyze_Exception_Handler): If there is a choice
	parameter, then the handler is not a suitable target for a local raise,
	and this is a violation of restriction No_Exception_Propagation.
	(Analyze_Handled_Statements): Analyze choice parameters in exception
	handlers before analyzing statement sequence (needed for proper
	detection of local raise statements).
	(Analyze_Raise_Statement): Reraise statement is a violation of the
	No_Exception_Propagation restriction.

	* s-rident.ads: Add new restriction No_Exception_Propagation

	* tbuild.ads, tbuild.adb (Make_Implicit_Exception_Handler): New
	function, like Make_Exception_Handler but sets Local_Raise_Statements
	to No_List.
	(Add_Unique_Serial_Number): Deal with case where this is called during
	processing of configuration pragmas.

From-SVN: r123541

gcc/ada/a-except-2005.adb

@@ -760,6 +760,16 @@ package body Ada.Exceptions is
    --  in case we do not want any exception tracing support. This is
    --  why this package is separated.
 
+   -----------------
+   -- Local_Raise --
+   -----------------
+
+   procedure Local_Raise (Excep : Exception_Id) is
+      pragma Warnings (Off, Excep);
+   begin
+      return;
+   end Local_Raise;
+
    -----------------------
    -- Stream Attributes --
    -----------------------

gcc/ada/a-except-2005.ads

@@ -139,6 +139,23 @@ package Ada.Exceptions is
      (Source : Exception_Occurrence)
       return   Exception_Occurrence_Access;
 
+   --  Ada 2005 (AI-438): The language revision introduces the
+   --  following subprograms and attribute definitions. We do not
+   --  provide them explicitly; instead, the corresponding stream
+   --  attributes are made available through a pragma Stream_Convert
+   --  in the private part of this package.
+
+   --  procedure Read_Exception_Occurrence
+   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+   --     Item   : out Exception_Occurrence);
+
+   --  procedure Write_Exception_Occurrence
+   --    (Stream : not null access Ada.Streams.Root_Stream_Type'Class;
+   --     Item   : Exception_Occurrence);
+
+   --  for Exception_Occurrence'Read use Read_Exception_Occurrence;
+   --  for Exception_Occurrence'Write use Write_Exception_Occurrence;
+
 private
    package SSL renames System.Standard_Library;
    package SP renames System.Parameters;
@@ -192,6 +209,15 @@ private
    --  private barrier, so we can place this function in the private part
    --  where the compiler can find it, but the spec is unchanged.)
 
+   procedure Local_Raise (Excep : Exception_Id);
+   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_id);
+   --    goto Handler
+
    procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
    pragma No_Return (Raise_Exception_Always);
    pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");

gcc/ada/a-except.adb

@@ -690,6 +690,16 @@ package body Ada.Exceptions is
    --  in case we do not want any exception tracing support. This is
    --  why this package is separated.
 
+   -----------------
+   -- Local_Raise --
+   -----------------
+
+   procedure Local_Raise (Excep : Exception_Id) is
+      pragma Warnings (Off, Excep);
+   begin
+      return;
+   end Local_Raise;
+
    -----------------------
    -- Stream Attributes --
    -----------------------

gcc/ada/a-except.ads

@@ -35,7 +35,10 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This version of Ada.Exceptions is a full Ada 95 version.
+--  This version of Ada.Exceptions is a full Ada 95 version. It omits Ada 2005
+--  features such as the additional definitions of Exception_Name returning
+--  Wide_[Wide_]String.
+
 --  It is used for building the compiler and the basic tools, since these
 --  builds may be done with bootstrap compilers that cannot handle these
 --  additions. The full version of Ada.Exceptions can be found in the files
@@ -172,6 +175,15 @@ private
    --  private barrier, so we can place this function in the private part
    --  where the compiler can find it, but the spec is unchanged.)
 
+   procedure Local_Raise (Excep : Exception_Id);
+   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_id);
+   --    goto Handler
+
    procedure Raise_Exception_Always (E : Exception_Id; Message : String := "");
    pragma No_Return (Raise_Exception_Always);
    pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception");

gcc/ada/debug.adb

@@ -99,7 +99,7 @@ package body Debug is
    --  d.d
    --  d.e
    --  d.f  Inhibit folding of static expressions
-   --  d.g
+   --  d.g  Enable conversion of raise into goto
    --  d.h
    --  d.i
    --  d.j
@@ -474,6 +474,11 @@ package body Debug is
    --       in seriously non-conforming behavior, but is useful sometimes
    --       when tracking down handling of complex expressions.
 
+   --  d.g  Enables conversion of a raise statement into a goto when the
+   --       relevant handler is statically determinable. For now we only try
+   --       this if this debug flag is set. Later we will enable this more
+   --       generally by default.
+
    --  d.l  Use Ada 95 semantics for limited function returns. This may be
    --       used to work around the incompatibility introduced by AI-318-2.
    --       It is useful only in -gnat05 mode.

gcc/ada/exp_ch11.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -56,6 +56,19 @@ package Exp_Ch11 is
    --  is also called to expand the special exception handler built for
    --  accept bodies (see Exp_Ch9.Build_Accept_Body).
 
+   function Get_Local_Raise_Call_Entity return Entity_Id;
+   --  This function is provided for use by the back end in conjunction with
+   --  generation of Local_Raise calls when an exception raise is converted to
+   --  a goto statement. If Local_Raise is defined, its entity is returned,
+   --  if not, Empty is returned (in which case the call is silently skipped).
+
+   function Get_RT_Exception_Entity (R : RT_Exception_Code) return Entity_Id;
+   --  This function is provided for use by the back end in conjunction with
+   --  generation of Local_Raise calls when an exception raise is converted to
+   --  a goto statement. The argument is the reason code which would be used
+   --  to determine which Rcheck_nn procedure to call. The returned result is
+   --  the exception entity to be passed to Local_Raise.
+
    function Is_Non_Ada_Error (E : Entity_Id) return Boolean;
    --  This function is provided for Gigi use. It returns True if operating on
    --  VMS, and the argument E is the entity for System.Aux_Dec.Non_Ada_Error.

gcc/ada/exp_sel.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          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- --
@@ -63,7 +63,7 @@ package body Exp_Sel is
 
               Exception_Handlers =>
                 New_List (
-                  Make_Exception_Handler (Loc,
+                  Make_Implicit_Exception_Handler (Loc,
                     Exception_Choices =>
                       New_List (
                         New_Reference_To (Stand.Abort_Signal, Loc)),

gcc/ada/gnatbind.adb

@@ -121,12 +121,15 @@ procedure Gnatbind is
 
       --  Define those restrictions that should be output if the gnatbind
       --  -r switch is used. Not all restrictions are output for the reasons
-      --  given above in the list, and this array is used to test whether
+      --  given below in the list, and this array is used to test whether
       --  the corresponding pragma should be listed. True means that it
       --  should not be listed.
 
       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
-        (No_Exceptions            => True,
+        (No_Exception_Propagation => True,
+         --  Modifies code resulting in different exception semantics
+
+         No_Exceptions            => True,
          --  Has unexpected Suppress (All_Checks) effect
 
          No_Implicit_Conditionals => True,
@@ -268,7 +271,7 @@ procedure Gnatbind is
                   "procedure names missing in -L");
             end if;
 
-         --  -Sin -Slo -Shi -Sxx
+         --  -Sin -Slo -Shi -Sxx -Sev
 
          elsif Argv'Length = 4
            and then Argv (2) = 'S'

gcc/ada/par-ch11.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          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- --
@@ -94,6 +94,7 @@ package body Ch11 is
 
    begin
       Handler_Node := New_Node (N_Exception_Handler, Token_Ptr);
+      Set_Local_Raise_Statements (Handler_Node, No_Elist);
       T_When;
 
       --  Test for possible choice parameter present

gcc/ada/restrict.adb

@@ -129,22 +129,32 @@ package body Restrict is
                      Get_File_Name (U, Subunit => False);
 
          begin
-            if not Is_Predefined_File_Name (Fnam) then
-               return;
+            --  Get file name
 
-            --  Predefined spec, needs checking against list
+            Get_Name_String (Fnam);
 
-            else
-               --  Pad name to 8 characters with blanks
+            --  Nothing to do if name not at least 5 characters long ending
+            --  in .ads or .adb extension, which we strip.
+
+            if Name_Len < 5
+              or else (Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads"
+                         and then
+                       Name_Buffer (Name_Len - 4 .. Name_Len) /= ".adb")
+            then
+               return;
+            end if;
 
-               Get_Name_String (Fnam);
-               Name_Len := Name_Len - 4;
+            --  Strip extension and pad to eight characters
 
-               while Name_Len < 8 loop
-                  Name_Len := Name_Len + 1;
-                  Name_Buffer (Name_Len) := ' ';
-               end loop;
+            Name_Len := Name_Len - 4;
+            while Name_Len < 8 loop
+               Name_Len := Name_Len + 1;
+               Name_Buffer (Name_Len) := ' ';
+            end loop;
+
+            --  If predefined unit, check the list of restricted units
 
+            if Is_Predefined_File_Name (Fnam) then
                for J in Unit_Array'Range loop
                   if Name_Len = 8
                     and then Name_Buffer (1 .. 8) = Unit_Array (J).Filenm
@@ -152,6 +162,15 @@ package body Restrict is
                      Check_Restriction (Unit_Array (J).Res_Id, N);
                   end if;
                end loop;
+
+               --  If not predefied unit, then one special check still remains.
+               --  GNAT.Current_Exception is not allowed if we have restriction
+               --  No_Exception_Propagation active.
+
+            else
+               if Name_Buffer (1 .. 8) = "g-curexc" then
+                  Check_Restriction (No_Exception_Propagation, N);
+               end if;
             end if;
          end;
       end if;

gcc/ada/s-rident.ads

@@ -74,6 +74,7 @@ package System.Rident is
       No_Entry_Calls_In_Elaboration_Code,      -- GNAT
       No_Entry_Queue,                          -- GNAT (Ravenscar)
       No_Exception_Handlers,                   -- GNAT
+      No_Exception_Propagation,                -- GNAT
       No_Exception_Registration,               -- GNAT
       No_Exceptions,                           -- (RM H.4(12))
       No_Finalization,                         -- GNAT

gcc/ada/sem.adb

@@ -610,6 +610,12 @@ package body Sem is
            N_Mod_Clause                             |
            N_Modular_Type_Definition                |
            N_Ordinary_Fixed_Point_Definition        |
+           N_Pop_Constraint_Error_Label             |
+           N_Pop_Program_Error_Label                |
+           N_Pop_Storage_Error_Label                |
+           N_Push_Constraint_Error_Label            |
+           N_Push_Program_Error_Label               |
+           N_Push_Storage_Error_Label               |
            N_Parameter_Specification                |
            N_Pragma_Argument_Association            |
            N_Procedure_Specification                |
@@ -626,18 +632,24 @@ package body Sem is
 
       Debug_A_Exit ("analyzing  ", N, "  (done)");
 
-      --  Now that we have analyzed the node, we call the expander to
-      --  perform possible expansion. This is done only for nodes that
-      --  are not subexpressions, because in the case of subexpressions,
-      --  we don't have the type yet, and the expander will need to know
-      --  the type before it can do its job. For subexpression nodes, the
-      --  call to the expander happens in the Sem_Res.Resolve.
+      --  Now that we have analyzed the node, we call the expander to perform
+      --  possible expansion. We skip this for subexpressions, because we don't
+      --  have the type yet, and the expander will need to know the type before
+      --  it can do its job. For subexpression nodes, the call to the expander
+      --  happens in Sem_Res.Resolve. A special exception is Raise_xxx_Error,
+      --  which can appear in a statement context, and needs expanding now in
+      --  the case (distinguished by Etype, as documented in Sinfo).
 
       --  The Analyzed flag is also set at this point for non-subexpression
-      --  nodes (in the case of subexpression nodes, we can't set the flag
-      --  yet, since resolution and expansion have not yet been completed)
-
-      if Nkind (N) not in N_Subexpr then
+      --  nodes (in the case of subexpression nodes, we can't set the flag yet,
+      --  since resolution and expansion have not yet been completed). Note
+      --  that for N_Raise_xxx_Error we have to distinguish the expression
+      --  case from the statement case.
+
+      if Nkind (N) not in N_Subexpr
+        or else (Nkind (N) in N_Raise_xxx_Error
+                  and then Etype (N) = Standard_Void_Type)
+      then
          Expand (N);
       end if;
    end Analyze;

gcc/ada/sem_ch11.adb

@@ -55,16 +55,14 @@ package body Sem_Ch11 is
    procedure Analyze_Exception_Declaration (N : Node_Id) is
       Id : constant Entity_Id := Defining_Identifier (N);
       PF : constant Boolean   := Is_Pure (Current_Scope);
-
    begin
-      Generate_Definition (Id);
-      Enter_Name          (Id);
-      Set_Ekind           (Id, E_Exception);
-      Set_Exception_Code  (Id, Uint_0);
-      Set_Etype           (Id, Standard_Exception_Type);
-
+      Generate_Definition         (Id);
+      Enter_Name                  (Id);
+      Set_Ekind                   (Id, E_Exception);
+      Set_Exception_Code          (Id, Uint_0);
+      Set_Etype                   (Id, Standard_Exception_Type);
       Set_Is_Statically_Allocated (Id);
-      Set_Is_Pure (Id, PF);
+      Set_Is_Pure                 (Id, PF);
    end Analyze_Exception_Declaration;
 
    --------------------------------
@@ -182,28 +180,35 @@ package body Sem_Ch11 is
          --  Otherwise we have a real exception handler
 
          else
-            --  Deal with choice parameter. The exception handler is
-            --  a declarative part for it, so it constitutes a scope
-            --  for visibility purposes. We create an entity to denote
-            --  the whole exception part, and use it as the scope of all
-            --  the choices, which may even have the same name without
-            --  conflict. This scope plays no other role in expansion or
-            --  or code generation.
+            --  Deal with choice parameter. The exception handler is a
+            --  declarative part for the choice parameter, so it constitutes a
+            --  scope for visibility purposes. We create an entity to denote
+            --  the whole exception part, and use it as the scope of all the
+            --  choices, which may even have the same name without conflict.
+            --  This scope plays no other role in expansion or or code
+            --  generation.
 
             Choice := Choice_Parameter (Handler);
 
             if Present (Choice) then
+               Set_Local_Raise_Not_OK (Handler);
+
+               if Comes_From_Source (Choice) then
+                  Check_Restriction (No_Exception_Propagation, Choice);
+               end if;
+
                if No (H_Scope) then
-                  H_Scope := New_Internal_Entity
-                    (E_Block, Current_Scope, Sloc (Choice), 'E');
+                  H_Scope :=
+                    New_Internal_Entity
+                     (E_Block, Current_Scope, Sloc (Choice), 'E');
                end if;
 
                New_Scope (H_Scope);
                Set_Etype (H_Scope, Standard_Void_Type);
 
                --  Set the Finalization Chain entity to Error means that it
-               --  should not be used at that level but the parent one
-               --  should be used instead.
+               --  should not be used at that level but the parent one should
+               --  be used instead.
 
                --  ??? this usage needs documenting in Einfo/Exp_Ch7 ???
                --  ??? using Error for this non-error condition is nasty ???
@@ -215,8 +220,8 @@ package body Sem_Ch11 is
                Set_Etype (Choice, RTE (RE_Exception_Occurrence));
                Generate_Definition (Choice);
 
-               --  Set source assigned flag, since in effect this field
-               --  is always assigned an initial value by the exception.
+               --  Set source assigned flag, since in effect this field is
+               --  always assigned an initial value by the exception.
 
                Set_Never_Set_In_Source (Choice, False);
             end if;
@@ -234,8 +239,20 @@ package body Sem_Ch11 is
                else
                   Analyze (Id);
 
+                  --  In most cases the choice has already been analyzed in
+                  --  Analyze_Handled_Statement_Sequence, in order to expand
+                  --  local handlers. This advance analysis does not take into
+                  --  account the case in which a choice has the same name as
+                  --  the choice parameter of the handler, which may hide an
+                  --  outer exception. This pathological case appears in ACATS
+                  --  B80001_3.adb, and requires an explicit check to verify
+                  --  that the id is not hidden.
+
                   if not Is_Entity_Name (Id)
                     or else Ekind (Entity (Id)) /= E_Exception
+                    or else
+                      (Nkind (Id) = N_Identifier
+                        and then Chars (Id) = Chars (Choice))
                   then
                      Error_Msg_N ("exception name expected", Id);
 
@@ -303,9 +320,9 @@ package body Sem_Ch11 is
                Next (Id);
             end loop;
 
-            --  Check for redundant handler (has only raise statement) and
-            --  is either an others handler, or is a specific handler when
-            --  no others handler is present.
+            --  Check for redundant handler (has only raise statement) and is
+            --  either an others handler, or is a specific handler when no
+            --  others handler is present.
 
             if Warn_On_Redundant_Constructs
               and then List_Length (Statements (Handler)) = 1
@@ -342,20 +359,45 @@ package body Sem_Ch11 is
 
    procedure Analyze_Handled_Statements (N : Node_Id) is
       Handlers : constant List_Id := Exception_Handlers (N);
+      Handler  : Node_Id;
+      Choice   : Node_Id;
 
    begin
       if Present (Handlers) then
          Kill_All_Checks;
       end if;
 
+      --  We are now going to analyze the statements and then the exception
+      --  handlers. We certainly need to do things in this order to get the
+      --  proper sequential semantics for various warnings.
+
+      --  However, there is a glitch. When we process raise statements, an
+      --  optimization is to look for local handlers and specialize the code
+      --  in this case.
+
+      --  In order to detect if a handler is matching, we must have at least
+      --  analyzed the choices in the proper scope so that proper visibility
+      --  analysis is performed. Hence we analyze just the choices first,
+      --  before we analyze the statement sequence.
+
+      Handler := First_Non_Pragma (Handlers);
+      while Present (Handler) loop
+         Choice := First_Non_Pragma (Exception_Choices (Handler));
+         while Present (Choice) loop
+            Analyze (Choice);
+            Next_Non_Pragma (Choice);
+         end loop;
+
+         Next_Non_Pragma (Handler);
+      end loop;
+
       --  Analyze statements in sequence
 
       Analyze_Statements (Statements (N));
 
-      --  If the current scope is a subprogram, and there are no explicit
-      --  exception handlers, then this is the right place to check for
-      --  hanging useless assignments from the statement sequence of the
-      --  subprogram body.
+      --  If the current scope is a subprogram, then this is the right place to
+      --  check for hanging useless assignments from the statement sequence of
+      --  the subprogram body.
 
       if Is_Subprogram (Current_Scope) then
          Warn_On_Useless_Assignments (Current_Scope);
@@ -389,9 +431,9 @@ package body Sem_Ch11 is
          Check_Restriction (No_Exceptions, N);
       end if;
 
-      --  Check for useless assignment to OUT or IN OUT scalar
-      --  immediately preceding the raise. Right now we only look
-      --  at assignment statements, we could do more.
+      --  Check for useless assignment to OUT or IN OUT scalar immediately
+      --  preceding the raise. Right now we only look at assignment statements,
+      --  we could do more.
 
       if Is_List_Member (N) then
          declare
@@ -424,7 +466,6 @@ package body Sem_Ch11 is
       --  Reraise statement
 
       if No (Exception_Id) then
-
          P := Parent (N);
          Nkind_P := Nkind (P);
 
@@ -441,6 +482,14 @@ package body Sem_Ch11 is
          if Nkind (P) /= N_Exception_Handler then
             Error_Msg_N
               ("reraise statement must appear directly in a handler", N);
+
+         --  If a handler has a reraise, it cannot be the target of a local
+         --  raise (goto optimization is impossible), and if the no exception
+         --  propagation restriction is set, this is a violation.
+
+         else
+            Set_Local_Raise_Not_OK (P);
+            Check_Restriction (No_Exception_Propagation, N);
          end if;
 
       --  Normal case with exception id present

gcc/ada/tbuild.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          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- --
@@ -53,25 +53,46 @@ package body Tbuild is
    -- Add_Unique_Serial_Number --
    ------------------------------
 
-   procedure Add_Unique_Serial_Number is
-      Unit_Node : constant Node_Id := Unit (Cunit (Current_Sem_Unit));
+   Config_Serial_Number : Nat := 0;
+   --  Counter for use in config pragmas, see comment below
 
+   procedure Add_Unique_Serial_Number is
    begin
-      Add_Nat_To_Name_Buffer (Increment_Serial_Number);
+      --  If we are analyzing configuration pragmas, Cunit (Main_Unit) will
+      --  not be set yet. This happens for example when analyzing static
+      --  string expressions in configuration pragmas. For this case, we
+      --  just maintain a local counter, defined above and we do not need
+      --  to add a b or s indication in this case.
 
-      --  Add either b or s, depending on whether current unit is a spec
-      --  or a body. This is needed because we may generate the same name
-      --  in a spec and a body otherwise.
+      if No (Cunit (Current_Sem_Unit)) then
+         Config_Serial_Number := Config_Serial_Number + 1;
+         Add_Nat_To_Name_Buffer (Config_Serial_Number);
+         return;
 
-      Name_Len := Name_Len + 1;
+      --  Normal case, within a unit
 
-      if Nkind (Unit_Node) = N_Package_Declaration
-        or else Nkind (Unit_Node) = N_Subprogram_Declaration
-        or else Nkind (Unit_Node) in N_Generic_Declaration
-      then
-         Name_Buffer (Name_Len) := 's';
       else
-         Name_Buffer (Name_Len) := 'b';
+         declare
+            Unit_Node : constant Node_Id := Unit (Cunit (Current_Sem_Unit));
+
+         begin
+            Add_Nat_To_Name_Buffer (Increment_Serial_Number);
+
+            --  Add either b or s, depending on whether current unit is a spec
+            --  or a body. This is needed because we may generate the same name
+            --  in a spec and a body otherwise.
+
+            Name_Len := Name_Len + 1;
+
+            if Nkind (Unit_Node) = N_Package_Declaration
+              or else Nkind (Unit_Node) = N_Subprogram_Declaration
+              or else Nkind (Unit_Node) in N_Generic_Declaration
+            then
+               Name_Buffer (Name_Len) := 's';
+            else
+               Name_Buffer (Name_Len) := 'b';
+            end if;
+         end;
       end if;
    end Add_Unique_Serial_Number;
 
@@ -178,6 +199,24 @@ package body Tbuild is
               New_Reference_To (First_Tag_Component (Full_Type), Loc)));
    end Make_DT_Access;
 
+   -------------------------------------
+   -- Make_Implicit_Exception_Handler --
+   -------------------------------------
+
+   function Make_Implicit_Exception_Handler
+     (Sloc              : Source_Ptr;
+      Choice_Parameter  : Node_Id := Empty;
+      Exception_Choices : List_Id;
+      Statements        : List_Id) return Node_Id
+   is
+      Handler : constant Node_Id :=
+                  Make_Exception_Handler
+                    (Sloc, Choice_Parameter, Exception_Choices, Statements);
+   begin
+      Set_Local_Raise_Statements (Handler, No_Elist);
+      return Handler;
+   end Make_Implicit_Exception_Handler;
+
    --------------------------------
    -- Make_Implicit_If_Statement --
    --------------------------------

gcc/ada/tbuild.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -74,6 +74,17 @@ package Tbuild is
    --  Create an access to the Dispatch Table by using the Tag field
    --  of a tagged record : Acc_Dt (Rec.tag).all
 
+   function Make_Implicit_Exception_Handler
+     (Sloc              : Source_Ptr;
+      Choice_Parameter  : Node_Id := Empty;
+      Exception_Choices : List_Id;
+      Statements        : List_Id) return Node_Id;
+   pragma Inline (Make_Implicit_Exception_Handler);
+   --  This is just like Make_Exception_Handler, except that it also sets the
+   --  Local_Raise_Statements field to No_Elist, ensuring that it is properly
+   --  initialized. This should always be used when creating exception handlers
+   --  as part of the expansion.
+
    function Make_Implicit_If_Statement
      (Node            : Node_Id;
       Condition       : Node_Id;