| -- CB20006.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 exceptions are raised and properly handled (including |
| -- propagation by reraise) in protected operations. |
| -- |
| -- TEST DESCRIPTION: |
| -- Declare a package with a protected type, including protected operation |
| -- declarations and private data, simulating a counting semaphore. |
| -- In the main procedure, perform calls on protected operations |
| -- of the protected object designed to induce the raising of exceptions. |
| -- |
| -- The exceptions raised are to be initially handled in the protected |
| -- operations, but this handling involves the reraise of the exception |
| -- and the propagation of the exception to the caller. |
| -- |
| -- Ensure that the exceptions are raised, handled / reraised successfully |
| -- in protected procedures and functions. Use "others" handlers in the |
| -- protected operations. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- |
| --! |
| |
| package CB20006_0 is -- Package Semaphore. |
| |
| Reraised_In_Function, |
| Reraised_In_Procedure, |
| Handled_In_Function_Caller, |
| Handled_In_Procedure_Caller : Boolean := False; |
| |
| Resource_Overflow, |
| Resource_Underflow : exception; |
| |
| protected type Counting_Semaphore (Max_Resources : Integer) is |
| procedure Secure; |
| function Resource_Limit_Exceeded return Boolean; |
| procedure Release; |
| private |
| Count : Integer := Max_Resources; |
| end Counting_Semaphore; |
| |
| end CB20006_0; |
| |
| --=================================================================-- |
| |
| with Report; |
| |
| package body CB20006_0 is -- Package Semaphore. |
| |
| protected body Counting_Semaphore is |
| |
| procedure Secure is |
| begin |
| if (Count = 0) then -- No resources left to secure. |
| raise Resource_Underflow; |
| Report.Failed |
| ("Program control not transferred by raise in Procedure Secure"); |
| else |
| Count := Count - 1; -- Available resources decremented. |
| end if; |
| exception |
| when Resource_Underflow => |
| Reraised_In_Procedure := True; |
| raise; -- Exception propagated to caller. |
| Report.Failed ("Exception not propagated to caller from Secure"); |
| when others => |
| Report.Failed ("Unexpected exception raised in Secure"); |
| end Secure; |
| |
| |
| function Resource_Limit_Exceeded return Boolean is |
| begin |
| if (Count > Max_Resources) then |
| raise Resource_Overflow; -- Exception used as control flow |
| -- mechanism. |
| Report.Failed |
| ("Specific raise did not alter program control" & |
| " from Resource_Limit_Exceeded"); |
| else |
| return (False); |
| end if; |
| exception |
| when others => |
| Reraised_In_Function := True; |
| raise; -- Exception propagated to caller. |
| Report.Failed ("Exception not propagated to caller" & |
| " from Resource_Limit_Exceeded"); |
| end Resource_Limit_Exceeded; |
| |
| |
| procedure Release is |
| begin |
| Count := Count + 1; -- Count of resources available |
| -- incremented. |
| if Resource_Limit_Exceeded then -- Call to protected operation |
| Count := Count - 1; -- function that raises/reraises |
| -- an exception. |
| Report.Failed("Resource limit exceeded"); |
| end if; |
| |
| exception |
| when others => |
| raise; -- Reraised and propagated again. |
| Report.Failed ("Exception not reraised by procedure Release"); |
| end Release; |
| |
| |
| end Counting_Semaphore; |
| |
| end CB20006_0; |
| |
| |
| --=================================================================-- |
| |
| |
| with CB20006_0; -- Package Semaphore. |
| with Report; |
| |
| procedure CB20006 is |
| begin |
| |
| Report.Test ("CB20006", "Check that exceptions are raised and " & |
| "handled / reraised and propagated " & |
| "correctly by protected operations" ); |
| |
| Test_Block: |
| declare |
| |
| package Semaphore renames CB20006_0; |
| |
| Total_Resources_Available : constant := 1; |
| |
| Resources : Semaphore.Counting_Semaphore (Total_Resources_Available); |
| -- An object of protected type. |
| |
| begin |
| |
| Allocate_Resources: |
| declare |
| Loop_Count : Integer := Total_Resources_Available + 1; |
| begin |
| for I in 1..Loop_Count loop -- Force exception |
| Resources.Secure; |
| end loop; |
| Report.Failed |
| ("Exception not propagated from protected operation Secure"); |
| exception |
| when Semaphore.Resource_Underflow => -- Exception propagated |
| Semaphore.Handled_In_Procedure_Caller := True; -- from protected |
| when others => -- procedure. |
| Semaphore.Handled_In_Procedure_Caller := False; |
| end Allocate_Resources; |
| |
| |
| Deallocate_Resources: |
| declare |
| Loop_Count : Integer := Total_Resources_Available + 1; |
| begin |
| for I in 1..Loop_Count loop -- Force exception |
| Resources.Release; |
| end loop; |
| Report.Failed |
| ("Exception not propagated from protected operation Release"); |
| exception |
| when Semaphore.Resource_Overflow => -- Exception propagated |
| Semaphore.Handled_In_Function_Caller := True; -- from protected |
| when others => -- function. |
| Semaphore.Handled_In_Function_Caller := False; |
| end Deallocate_Resources; |
| |
| |
| if not (Semaphore.Reraised_In_Procedure and |
| Semaphore.Reraised_In_Function and |
| Semaphore.Handled_In_Procedure_Caller and |
| Semaphore.Handled_In_Function_Caller) |
| then -- Incorrect excpt. handling |
| Report.Failed -- in protected operations. |
| ("Improper exception handling/reraising by protected operations"); |
| end if; |
| |
| exception |
| |
| when others => |
| Report.Failed ("Unexpected exception " & |
| " raised and propagated in test"); |
| end Test_Block; |
| |
| Report.Result; |
| |
| |
| end CB20006; |
