[Ada] improve exception message

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

This change improves the exception message associated with the raising
of Program_Error as a consequence of an exception being propagated by
an Adjust or Finalize operation.

Test case:
$ gnatmake -gnat05 proc
$ proc
Finalize raised: Exception name: PROGRAM_ERROR
Message: adjust/finalize raised PAK.EXC_IN_FINALIZE: exception in finalize

Finalize raised: Exception name: PROGRAM_ERROR
Message: adjust/finalize raised PAK.EXC_IN_ADJUST: exception in adjust

with Ada.Finalization;

package Pak is
   Exc_In_Adjust   : exception;
   Exc_In_Finalize : exception;

   type Misbehaving is new Ada.Finalization.Controlled with record
      Raise_In_Finalize : Boolean := False;
   end record;

   procedure Adjust (X : in out Misbehaving);
   --  Raise Exc_In_Adjust

   procedure Finalize (X : in out Misbehaving);
   --  Raise Exc_In_Finalize if Raise_In_Finalize is True

end Pak;
package body Pak is
   procedure Adjust (X : in out Misbehaving) is
   begin
      raise Exc_In_Adjust with "exception in adjust";
   end Adjust;

   procedure Finalize (X : in out Misbehaving) is
   begin
      if X.Raise_In_Finalize then
         raise Exc_In_Finalize with "exception in finalize";
      end if;
   end Finalize;

end Pak;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO;    use Ada.Text_IO;

with Pak;            use Pak;

procedure Proc is
begin
   begin
      declare
         X : Misbehaving;
      begin
         X.Raise_In_Finalize := True;
      end;
   exception
      when E : others =>
         Put_Line ("Finalize raised: " & Exception_Information (E));
   end;

   begin
      declare
         X, Y : Misbehaving;
      begin
         X := Y;
         --  Adjust will raise Exc_In_Adjust

         raise Program_Error with "should never be reached";
      end;
   exception
      when E : others =>
         Put_Line ("Finalize raised: " & Exception_Information (E));
   end;

end Proc;

Actions that are generated within a transient scope are saved in the scope stack
entry, and inserted into the tree when the current statement is finally replaced
with a block. If the statement is the triggering statement in an asynchronous
select statement (a call or a delay statement), the generated actions must be
inserted before the select itself. However, if the statement appears in the
statement list that can follow the trigger  then the actions belong within the
block, as in all other cases.

gnat.dg/async.adb must compile quietly.

2007-06-06  Ed Schonberg  <schonberg@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* exp_ch7.ads, exp_ch7.adb (Expand_Cleanup_Actions): Set Sloc of
	inserted cleanup code appropriately for GDB use.
	(Make_Deep_Proc): Use Make_Handler_For_Ctrl_Operation to create
	exception handler for Deep_Adjust or Deep_Finalize.
	(Make_Handler_For_Ctrl_Operation): New subprogram. When runtime entity
	Raise_From_Controlled_Operation is available, use a call to that
	subprogram instead of a plain "raise Program_Error" node to raise
	Program_Error if an exception is propagated from an Adjust or Finalize
	operation.
	(Insert_Actions_In_Scope_Around): If the statement to be wrapped
	appears in the optional statement list of a triggering alternative, the
	scope actions can be inserted directly there, and not in the list that
	includes the asynchronous select itself.

Attachment: difs
Description: Text document