From: Robert Dewar Date: Tue, 8 Apr 2008 06:47:27 +0000 (+0200) Subject: 2008-04-08 Robert Dewar X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=151463df56379965e7782b7037a4190566aa7011;p=gcc.git 2008-04-08 Robert Dewar * a-except-2005.ads, a-except-2005.adb, a-except.ads, a-except.adb (Raise_Exception): In accordance with AI-446, raise CE for Null_Id (Raise_Exception_Always): Fix documentation accordingly From-SVN: r134018 --- diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 402a04cbe85..14624cb8178 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -420,11 +420,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); @@ -838,20 +838,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 we simply return, which is correct Ada 95 - -- semantics. If we are operating in Ada 2005 mode, then the expander - -- generates a raise Constraint_Error immediately following the call - -- to provide the required Ada 2005 semantics (see AI-329). We do it - -- this way to avoid having run time dependencies on the Ada version. + -- Go ahead and raise appropriate exception - return; + Exception_Data.Set_Exception_Msg (EF, Message); + Abort_Defer.all; + Raise_Current_Excep (EF); end Raise_Exception; ---------------------------- diff --git a/gcc/ada/a-except-2005.ads b/gcc/ada/a-except-2005.ads index 6dae91ff467..79e25123076 100644 --- a/gcc/ada/a-except-2005.ads +++ b/gcc/ada/a-except-2005.ads @@ -93,12 +93,8 @@ package Ada.Exceptions is pragma Ada_05 (Wide_Wide_Exception_Name); procedure Raise_Exception (E : Exception_Id; Message : String := ""); - -- Note: it would be really nice to give a pragma No_Return for this - -- procedure, but it would be wrong, since Raise_Exception does return - -- if given the null exception. However we do special case the name in - -- the test in the compiler for issuing a warning for a missing return - -- after this call. Program_Error seems reasonable enough in such a case. - -- See also the routine Raise_Exception_Always in the private part. + pragma No_Return (Raise_Exception); + -- Note: In accordance with AI-466, CE is raised if E = Null_Id function Exception_Message (X : Exception_Occurrence) return String; @@ -135,11 +131,10 @@ 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. + -- 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. -- procedure Read_Exception_Occurrence -- (Stream : not null access Ada.Streams.Root_Stream_Type'Class; @@ -209,10 +204,10 @@ private pragma No_Return (Raise_Exception_Always); pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception"); -- This differs from Raise_Exception only in that the caller has determined - -- that for sure the parameter E is not null, and that therefore the call - -- to this procedure cannot return. The expander converts Raise_Exception - -- calls to Raise_Exception_Always if it can determine this is the case. - -- The Export allows this routine to be accessed from Pure units. + -- that for sure the parameter E is not null, and that therefore no check + -- for Null_Id is required. The expander converts Raise_Exception calls to + -- Raise_Exception_Always if it can determine this is the case. The Export + -- allows this routine to be accessed from Pure units. procedure Raise_From_Signal_Handler (E : Exception_Id; diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb index a07bf294203..7168d48dbfd 100644 --- a/gcc/ada/a-except.adb +++ b/gcc/ada/a-except.adb @@ -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; ---------------------------- diff --git a/gcc/ada/a-except.ads b/gcc/ada/a-except.ads index a97ccb44032..e9f5ecd687e 100644 --- a/gcc/ada/a-except.ads +++ b/gcc/ada/a-except.ads @@ -84,12 +84,8 @@ package Ada.Exceptions is function Exception_Name (Id : Exception_Id) return String; procedure Raise_Exception (E : Exception_Id; Message : String := ""); - -- Note: it would be really nice to give a pragma No_Return for this - -- procedure, but it would be wrong, since Raise_Exception does return if - -- given the null exception in Ada 95 mode. However we do special case the - -- name in the test in the compiler for issuing a warning for a missing - -- return after this call. Program_Error seems reasonable enough in such a - -- case. See also the routine Raise_Exception_Always in the private part. + pragma No_Return (Raise_Exception); + -- Note: In accordance with AI-466, CE is raised if E = Null_Id function Exception_Message (X : Exception_Occurrence) return String; @@ -183,10 +179,10 @@ private pragma No_Return (Raise_Exception_Always); pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception"); -- This differs from Raise_Exception only in that the caller has determined - -- that for sure the parameter E is not null, and that therefore the call - -- to this procedure cannot return. The expander converts Raise_Exception - -- calls to Raise_Exception_Always if it can determine this is the case. - -- The Export allows this routine to be accessed from Pure units. + -- that for sure the parameter E is not null, and that therefore no check + -- for Null_Id is required. The expander converts Raise_Exception calls to + -- Raise_Exception_Always if it can determine this is the case. The Export + -- allows this routine to be accessed from Pure units. procedure Raise_From_Signal_Handler (E : Exception_Id;