diff options
Diffstat (limited to 'gcc/ada/a-except-2005.adb')
| -rw-r--r-- | gcc/ada/a-except-2005.adb | 48 |
1 files changed, 29 insertions, 19 deletions
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 9db770c..ad43e21 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -457,6 +457,7 @@ package body Ada.Exceptions is procedure Rcheck_30 (File : System.Address; Line : Integer); procedure Rcheck_31 (File : System.Address; Line : Integer); procedure Rcheck_32 (File : System.Address; Line : Integer); + procedure Rcheck_33 (File : System.Address; Line : Integer); pragma Export (C, Rcheck_00, "__gnat_rcheck_00"); pragma Export (C, Rcheck_01, "__gnat_rcheck_01"); @@ -491,6 +492,7 @@ package body Ada.Exceptions is pragma Export (C, Rcheck_30, "__gnat_rcheck_30"); pragma Export (C, Rcheck_31, "__gnat_rcheck_31"); pragma Export (C, Rcheck_32, "__gnat_rcheck_32"); + pragma Export (C, Rcheck_33, "__gnat_rcheck_33"); -- None of these procedures ever returns (they raise an exception!). By -- using pragma No_Return, we ensure that any junk code after the call, @@ -528,6 +530,7 @@ package body Ada.Exceptions is pragma No_Return (Rcheck_29); pragma No_Return (Rcheck_30); pragma No_Return (Rcheck_32); + pragma No_Return (Rcheck_33); --------------------------------------------- -- Reason Strings for Run-Time Check Calls -- @@ -554,25 +557,27 @@ package body Ada.Exceptions is Rmsg_13 : constant String := "tag check failed" & NUL; Rmsg_14 : constant String := "access before elaboration" & NUL; Rmsg_15 : constant String := "accessibility check failed" & NUL; - Rmsg_16 : constant String := "all guards closed" & NUL; - Rmsg_17 : constant String := "Current_Task referenced in entry" & + Rmsg_16 : constant String := "attempt to take address of" & + " intrinsic subprogram" & NUL; + Rmsg_17 : constant String := "all guards closed" & NUL; + Rmsg_18 : constant String := "Current_Task referenced in entry" & " body" & NUL; - Rmsg_18 : constant String := "duplicated entry address" & NUL; - Rmsg_19 : constant String := "explicit raise" & NUL; - Rmsg_20 : constant String := "finalize/adjust raised exception" & NUL; - Rmsg_21 : constant String := "implicit return with No_Return" & NUL; - Rmsg_22 : constant String := "misaligned address value" & NUL; - Rmsg_23 : constant String := "missing return" & NUL; - Rmsg_24 : constant String := "overlaid controlled object" & NUL; - Rmsg_25 : constant String := "potentially blocking operation" & NUL; - Rmsg_26 : constant String := "stubbed subprogram called" & NUL; - Rmsg_27 : constant String := "unchecked union restriction" & NUL; - Rmsg_28 : constant String := "actual/returned class-wide value " - & "not transportable" & NUL; - Rmsg_29 : constant String := "empty storage pool" & NUL; - Rmsg_30 : constant String := "explicit raise" & NUL; - Rmsg_31 : constant String := "infinite recursion" & NUL; - Rmsg_32 : constant String := "object too large" & NUL; + Rmsg_19 : constant String := "duplicated entry address" & NUL; + Rmsg_20 : constant String := "explicit raise" & NUL; + Rmsg_21 : constant String := "finalize/adjust raised exception" & NUL; + Rmsg_22 : constant String := "implicit return with No_Return" & NUL; + Rmsg_23 : constant String := "misaligned address value" & NUL; + Rmsg_24 : constant String := "missing return" & NUL; + Rmsg_25 : constant String := "overlaid controlled object" & NUL; + Rmsg_26 : constant String := "potentially blocking operation" & NUL; + Rmsg_27 : constant String := "stubbed subprogram called" & NUL; + Rmsg_28 : constant String := "unchecked union restriction" & NUL; + Rmsg_29 : constant String := "actual/returned class-wide" & + " value not transportable" & NUL; + Rmsg_30 : constant String := "empty storage pool" & NUL; + Rmsg_31 : constant String := "explicit raise" & NUL; + Rmsg_32 : constant String := "infinite recursion" & NUL; + Rmsg_33 : constant String := "object too large" & NUL; ----------------------- -- Polling Interface -- @@ -1161,7 +1166,7 @@ package body Ada.Exceptions is procedure Rcheck_29 (File : System.Address; Line : Integer) is begin - Raise_Storage_Error_Msg (File, Line, Rmsg_29'Address); + Raise_Program_Error_Msg (File, Line, Rmsg_29'Address); end Rcheck_29; procedure Rcheck_30 (File : System.Address; Line : Integer) is @@ -1179,6 +1184,11 @@ package body Ada.Exceptions is Raise_Storage_Error_Msg (File, Line, Rmsg_32'Address); end Rcheck_32; + procedure Rcheck_33 (File : System.Address; Line : Integer) is + begin + Raise_Storage_Error_Msg (File, Line, Rmsg_33'Address); + end Rcheck_33; + ------------- -- Reraise -- ------------- |