2008-05-27 Vincent Celier <celier@adacore.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / a-except.adb

diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 60f5995..7168d48 100644 (file)
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -377,11 +377,11 @@ package body Ada.Exceptions is
    -- Run-Time Check Routines --
    -----------------------------
 
-   --  These routines are called from the runtime to raise a specific
-   --  exception with a reason message attached. The parameters are
-   --  the file name and line number in each case. The names are keyed
-   --  to the codes defined in Types.ads and a-types.h (for example,
-   --  the name Rcheck_05 refers to the Reason whose Pos code is 5).
+   --  These routines raise a specific exception with a reason message
+   --  attached. The parameters are the file name and line number in each
+   --  case. The names are keyed to the codes defined in types.ads and
+   --  a-types.h (for example, the name Rcheck_05 refers to the Reason
+   --  RT_Exception_Code'Val (5)).
 
    procedure Rcheck_00 (File : System.Address; Line : Integer);
    procedure Rcheck_01 (File : System.Address; Line : Integer);
@@ -807,16 +807,20 @@ package body Ada.Exceptions is
      (E       : Exception_Id;
       Message : String := "")
    is
+      EF : Exception_Id := E;
+
    begin
-      if E /= null then
-         Exception_Data.Set_Exception_Msg (E, Message);
-         Abort_Defer.all;
-         Raise_Current_Excep (E);
+      --  Raise CE if E = Null_ID (AI-446)
+
+      if E = null then
+         EF := Constraint_Error'Identity;
       end if;
 
-      --  Note: if E is null then just return (Ada 95 semantics)
+      --  Go ahead and raise appropriate exception
 
-      return;
+      Exception_Data.Set_Exception_Msg (EF, Message);
+      Abort_Defer.all;
+      Raise_Current_Excep (EF);
    end Raise_Exception;
 
    ----------------------------