exp_ch11.adb (Expand_At_End_Handler): Set From_At_End flag on raise stmt.

2008-03-26  Robert Dewar  <dewar@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* exp_ch11.adb (Expand_At_End_Handler): Set From_At_End flag on raise
	stmt.
	(No_Exception_Propagation_Active): New function.
	(Expand_Exception_Handlers): Use No_Exception_Propagation_Active.
	Update comments, and review all uses of No_Exception_Propagation, which
	are now correct and in sync with what gigi expects.

	* restrict.ads, restrict.adb (No_Exception_Propagation_Active): New
	function.
	(Expand_Exception_Handlers): Use No_Exception_Propagation_Active.
	Update comments, and review all uses of No_Exception_Propagation, which
	are now correct and in sync with what gigi expects.

From-SVN: r133560

gcc/ada/exp_ch11.adb

@@ -143,12 +143,21 @@ package body Exp_Ch11 is
         Make_Procedure_Call_Statement (Loc,
           Name => New_Occurrence_Of (Clean, Loc)));
 
-      --  Avoid generation of raise stmt if compiling with no exceptions
-      --  propagation
+      --  Generate reraise statement as last statement of AT-END handler,
+      --  unless we are under control of No_Exception_Propagation, in which
+      --  case no exception propagation is possible anyway, so we do not need
+      --  a reraise (the AT END handler in this case is only for normal exits
+      --  not for exceptional exits). Also, we flag the Reraise statement as
+      --  being part of an AT END handler to prevent signalling this reraise
+      --  as a violation of the restriction when it is not set.
 
       if not Restriction_Active (No_Exception_Propagation) then
-         Append_To (Stmnts,
-           Make_Raise_Statement (Loc));
+         declare
+            Rstm : constant Node_Id := Make_Raise_Statement (Loc);
+         begin
+            Set_From_At_End (Rstm);
+            Append_To (Stmnts, Rstm);
+         end;
       end if;
 
       Set_Exception_Handlers (HSS, New_List (
@@ -963,7 +972,7 @@ package body Exp_Ch11 is
       Handler_Loop : while Present (Handler) loop
          Next_Handler := Next_Non_Pragma (Handler);
 
-         --  Remove source handler if gnat debug flag N is set
+         --  Remove source handler if gnat debug flag .x is set
 
          if Debug_Flag_Dot_X and then Comes_From_Source (Handler) then
             Remove (Handler);
@@ -971,8 +980,9 @@ package body Exp_Ch11 is
          --  Remove handler if no exception propagation, generating a warning
          --  if a source generated handler was not the target of a local raise.
 
-         elsif Restriction_Active (No_Exception_Propagation) then
-            if not Has_Local_Raise (Handler)
+         else
+            if Restriction_Active (No_Exception_Propagation)
+              and then not Has_Local_Raise (Handler)
               and then Comes_From_Source (Handler)
               and then Warn_On_Non_Local_Exception
             then
@@ -982,13 +992,14 @@ package body Exp_Ch11 is
                   Handler);
             end if;
 
+            if No_Exception_Propagation_Active then
                Remove (Handler);
 
             --  Exception handler is active and retained and must be processed
 
             else
-            --  If an exception occurrence is present, then we must declare it
-            --  and initialize it from the value stored in the TSD
+               --  If an exception occurrence is present, then we must declare
+               --  it and initialize it from the value stored in the TSD
 
                --     declare
                --        name : Exception_Occurrence;
@@ -1039,16 +1050,17 @@ package body Exp_Ch11 is
                                Make_Handled_Sequence_Of_Statements (Loc,
                                  Statements => Statements (Handler))))));
 
-                  Analyze_List (Statements (Handler), Suppress => All_Checks);
+                     Analyze_List
+                       (Statements (Handler), Suppress => All_Checks);
                   end;
                end if;
 
                --  The processing at this point is rather different for the JVM
                --  case, so we completely separate the processing.
 
-            --  For the JVM case, we unconditionally call Update_Exception,
-            --  passing a call to the intrinsic Current_Target_Exception (see
-            --  JVM version of Ada.Exceptions in 4jexcept.adb for details).
+               --  For the VM case, we unconditionally call Update_Exception,
+               --  passing a call to the intrinsic Current_Target_Exception
+               --  (see JVM/.NET versions of Ada.Exceptions for details).
 
                if VM_Target /= No_VM then
                   declare
@@ -1065,9 +1077,9 @@ package body Exp_Ch11 is
                   --  For the normal case, we have to worry about the state of
                   --  abort deferral. Generally, we defer abort during runtime
                   --  handling of exceptions. When control is passed to the
-               --  handler, then in the normal case we undefer aborts. In any
-               --  case this entire handling is relevant only if aborts are
-               --  allowed!
+                  --  handler, then in the normal case we undefer aborts. In
+                  --  any case this entire handling is relevant only if aborts
+                  --  are allowed!
 
                elsif Abort_Allowed then
 
@@ -1076,27 +1088,31 @@ package body Exp_Ch11 is
                   --  wants to operate with aborts still deferred.
 
                   --  We also suppress the call if this is the special handler
-               --  for Abort_Signal, since if we are aborting, we want to keep
-               --  aborts deferred (one abort is enough).
+                  --  for Abort_Signal, since if we are aborting, we want to
+                  --  keep aborts deferred (one abort is enough).
 
-               --  If abort really needs to be deferred the expander must add
-               --  this call explicitly, see Expand_N_Asynchronous_Select.
+                  --  If abort really needs to be deferred the expander must
+                  --  add this call explicitly, see
+                  --  Expand_N_Asynchronous_Select.
 
                   Others_Choice :=
-                 Nkind (First (Exception_Choices (Handler))) = N_Others_Choice;
+                    Nkind (First (Exception_Choices (Handler))) =
+                                                         N_Others_Choice;
 
                   if (Others_Choice
                        or else Entity (First (Exception_Choices (Handler))) /=
                                                          Stand.Abort_Signal)
                     and then not
                       (Others_Choice
-                    and then All_Others (First (Exception_Choices (Handler))))
+                        and then
+                          All_Others (First (Exception_Choices (Handler))))
                     and then Abort_Allowed
                   then
                      Prepend_Call_To_Handler (RE_Abort_Undefer);
                   end if;
                end if;
             end if;
+         end if;
 
          Handler := Next_Handler;
       end loop Handler_Loop;
@@ -1248,7 +1264,6 @@ package body Exp_Ch11 is
             Insert_List_After_And_Analyze (N, L);
          end if;
       end if;
-
    end Expand_N_Exception_Declaration;
 
    ---------------------------------------------
@@ -1334,8 +1349,6 @@ package body Exp_Ch11 is
       H     : Node_Id;
 
    begin
-      --  Debug_Flag_Dot_G := True;
-
       --  Processing for locally handled exception (exclude reraise case)
 
       if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then

gcc/ada/restrict.adb

@@ -26,6 +26,7 @@
 with Atree;    use Atree;
 with Casing;   use Casing;
 with Errout;   use Errout;
+with Debug;    use Debug;
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
 with Lib;      use Lib;
@@ -430,6 +431,18 @@ package body Restrict is
                   Restrictions.Set (No_Exception_Propagation));
    end No_Exception_Handlers_Set;
 
+   -------------------------------------
+   -- No_Exception_Propagation_Active --
+   -------------------------------------
+
+   function No_Exception_Propagation_Active return Boolean is
+   begin
+      return (No_Run_Time_Mode
+               or else Configurable_Run_Time_Mode
+               or else Debug_Flag_Dot_G)
+        and then Restriction_Active (No_Exception_Propagation);
+   end No_Exception_Propagation_Active;
+
    ----------------------------------
    -- Process_Restriction_Synonyms --
    ----------------------------------

gcc/ada/restrict.ads

@@ -249,6 +249,10 @@ package Restrict is
    --  set. In the latter case, the source may contain handlers but they either
    --  get converted using the local goto transformation or deleted.
 
+   function No_Exception_Propagation_Active return Boolean;
+   --  Test to see if current restrictions settings specify that no
+   --  exception propagation is activated.
+
    function Process_Restriction_Synonyms (N : Node_Id) return Name_Id;
    --  Id is a node whose Chars field contains the name of a restriction.
    --  If it is one of synonyms that we allow for historical purposes (for