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

1 files changed, 22 insertions, 10 deletions

diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 8c5a2a5..7967c36 100644
--- a/gcc/ada/sem.adb
+++ b/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;