-- CB41002.A -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained -- unlimited rights in the software and documentation contained herein. -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making -- this public release, the Government intends to confer upon all -- recipients unlimited rights equal to those held by the Government. -- These rights include rights to use, duplicate, release or disclose the -- released technical data and computer software in whole or in part, in -- any manner and for any purpose whatsoever, and to have or permit others -- to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. --* -- -- OBJECTIVE: -- Check that the message string input parameter in a call to the -- Raise_Exception procedure is associated with the raised exception -- occurrence, and that the message string can be obtained using the -- Exception_Message function with the associated Exception_Occurrence -- object. Check that Function Exception_Information is available -- to provide implementation-defined information about the exception -- occurrence. -- -- TEST DESCRIPTION: -- This test checks that a message associated with a raised exception -- is propagated with the exception, and can be retrieved using the -- Exception_Message function. The exception will be raised using the -- 'Identity attribute as a parameter to the Raise_Exception procedure, -- and an associated message string will be provided. The exception -- will be handled, and the message associated with the occurrence will -- be compared to the original source message (non-default). -- -- The test also includes a simulated logging procedure -- (Check_Exception_Information) that checks that Exception_Information -- can be called. -- -- -- CHANGE HISTORY: -- 06 Dec 94 SAIC ACVC 2.0 -- 22 Jun 00 RLB Added a check at Exception_Information can be -- called. -- --! with Report; with Ada.Exceptions; procedure CB41002 is begin Report.Test ("CB41002", "Check that the message string input parameter " & "in a call to the Raise_Exception procedure is " & "associated with the raised exception " & "occurrence, and that the message string can " & "be obtained using the Exception_Message " & "function with the associated " & "Exception_Occurrence object. Also check that " & "the Exception_Information function can be called"); Test_Block: declare Number_Of_Exceptions : constant := 3; User_Exception_1, User_Exception_2, User_Exception_3 : exception; type String_Ptr is access String; User_Messages : constant array (1..Number_Of_Exceptions) of String_Ptr := (new String'("Msg"), new String'("This message will override the default " & "message provided by the implementation"), new String'("The message can be captured by procedure" & -- 200 chars " Exception_Message. It is designed to b" & "e exactly 200 characters in length, sinc" & "e there is a permission concerning the " & "truncation of a message over 200 chars. ")); procedure Check_Exception_Information ( Occur : in Ada.Exceptions.Exception_Occurrence) is -- Simulates an error logging routine. Info : constant String := Ada.Exceptions.Exception_Information (Occur); function Is_Substring_of (Target, Search : in String) return Boolean is -- Returns True if Search is a substring of Target, and False -- otherwise. begin for I in Report.Ident_Int(Target'First) .. Target'Last - Search'Length + 1 loop if Target(I .. I+Search'Length-1) = Search then return True; end if; end loop; return False; end Is_Substring_of; begin -- We can't display Info, as it often contains line breaks -- (confusing Report), and might look much like the failure of a test -- with an unhandled exception (thus confusing grading tools). -- -- We don't particular care if the implementation advice is followed, -- but we make these checks to insure that a compiler cannot optimize -- away Info or the rest of this routine. if not Is_Substring_of (Info, Ada.Exceptions.Exception_Name (Occur)) then Report.Comment ("Exception_Information does not contain " & "Exception_Name - see 11.4.1(19)"); elsif not Is_Substring_of (Info, Ada.Exceptions.Exception_Message (Occur)) then Report.Comment ("Exception_Information does not contain " & "Exception_Message - see 11.4.1(19)"); end if; end Check_Exception_Information; begin for i in 1..Number_Of_Exceptions loop begin -- Raise a user-defined exception with a specific message string. case i is when 1 => Ada.Exceptions.Raise_Exception(User_Exception_1'Identity, User_Messages(i).all); when 2 => Ada.Exceptions.Raise_Exception(User_Exception_2'Identity, User_Messages(i).all); when 3 => Ada.Exceptions.Raise_Exception(User_Exception_3'Identity, User_Messages(i).all); when others => Report.Failed("Incorrect result from Case statement"); end case; Report.Failed ("Exception not raised by procedure Exception_With_Message " & "for User_Exception #" & Integer'Image(i)); exception when Excptn : others => begin -- The message that is associated with the raising of each -- exception is captured here using the Exception_Message -- function. if User_Messages(i).all /= Ada.Exceptions.Exception_Message(Excptn) then Report.Failed ("Message captured from exception is not the " & "message provided when the exception was raised, " & "User_Exception #" & Integer'Image(i)); end if; Check_Exception_Information(Excptn); end; end; end loop; -- Verify that the exception specific message is carried across -- various boundaries: begin begin Ada.Exceptions.Raise_Exception(User_Exception_1'Identity, User_Messages(1).all); Report.Failed("User_Exception_1 not raised"); end; Report.Failed("User_Exception_1 not propagated"); exception when Excptn : User_Exception_1 => if User_Messages(1).all /= Ada.Exceptions.Exception_Message(Excptn) then Report.Failed("User_Message_1 not found"); end if; Check_Exception_Information(Excptn); when others => Report.Failed("Unexpected exception handled - 1"); end; begin begin Ada.Exceptions.Raise_Exception(User_Exception_2'Identity, User_Messages(2).all); Report.Failed("User_Exception_2 not raised"); exception when Exc : User_Exception_2 => -- The exception is reraised here; message should propagate -- with exception occurrence. Ada.Exceptions.Reraise_Occurrence(Exc); when others => Report.Failed("User_Exception_2 not handled"); end; Report.Failed("User_Exception_2 not propagated"); exception when Excptn : User_Exception_2 => if User_Messages(2).all /= Ada.Exceptions.Exception_Message(Excptn) then Report.Failed("User_Message_2 not found"); end if; Check_Exception_Information(Excptn); when others => Report.Failed("Unexpected exception handled - 2"); end; -- Check exception and message propagation across task boundaries. declare task Raise_An_Exception is -- single task entry Raise_It; end Raise_An_Exception; task body Raise_An_Exception is begin accept Raise_It do Ada.Exceptions.Raise_Exception(User_Exception_3'Identity, User_Messages(3).all); end Raise_It; Report.Failed("User_Exception_3 not raised"); exception when Excptn : User_Exception_3 => if User_Messages(3).all /= Ada.Exceptions.Exception_Message(Excptn) then Report.Failed ("User_Message_3 not returned inside task body"); end if; Check_Exception_Information(Excptn); when others => Report.Failed("Incorrect exception raised in task body"); end Raise_An_Exception; begin Raise_An_Exception.Raise_It; -- Exception will be propagated here. Report.Failed("User_Exception_3 not propagated to caller"); exception when Excptn : User_Exception_3 => if User_Messages(3).all /= Ada.Exceptions.Exception_Message(Excptn) then Report.Failed("User_Message_3 not returned to caller of task"); end if; Check_Exception_Information(Excptn); when others => Report.Failed("Incorrect exception raised by task"); end; exception when others => Report.Failed ("Exception raised in Test_Block"); end Test_Block; Report.Result; end CB41002;