diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada | 122 |
1 files changed, 122 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada new file mode 100644 index 000000000..cfe0a772d --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95040d.ada @@ -0,0 +1,122 @@ +-- C95040D.ADA + +-- 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. +--* +-- CHECK THAT TASKING_ERROR IS RAISED IN A CALLING +-- TASK WHEN THE TASK OWNING THE ENTRY TERMINATES BEFORE RENDEZVOUS +-- CAN OCCUR. + +-- CHECK THAT RE-RAISING TASKING_ERROR, ONCE TRAPPED IN THE CALLER, +-- DOES NOT PROPAGATE OUTSIDE THE TASK BODY. + +-- GOM 11/29/84 +-- JWC 05/14/85 +-- PWB 02/11/86 CORRECTED CALL TO TEST TO SHOW CORRECT TEST NAME. +-- RLB 12/15/99 REMOVED POTENTIALLY ERRONEOUS CALLS TO REPORT.COMMENT. + +WITH REPORT; +USE REPORT; + +PROCEDURE C95040D IS + + PROCEDURE DRIVER IS + + TASK NEST IS + ENTRY OUTER; + ENTRY INNER; + END NEST; + + TASK SLAVE; + + TASK BODY NEST IS + BEGIN + --COMMENT("AT TOP OF 'NEST' TASK WAITING ON 'OUTER' " & + -- "RENDEZVOUS"); + + ACCEPT OUTER DO + --COMMENT("IN 'OUTER' RENDEZVOUS OF 'NEST' TASK " & + -- "ABOUT TO 'RETURN'"); + + RETURN; -- CAUSES 'INNER' RENDEZVOUS TO BE SKIPPED. + + ACCEPT INNER DO + FAILED("'INNER' RENDEZVOUS OF 'NEST' TASK " & + "SHOULD NEVER BE PERFORMED"); + END INNER; + END OUTER; + + --COMMENT("'OUTER' RENDEZVOUS COMPLETED IN 'NEST' TASK " & + -- "AND NOW TERMINATING"); + END NEST; + + TASK BODY SLAVE IS + BEGIN + --COMMENT("AT TOP OF 'SLAVE' TASK. CALLING 'INNER' " & + -- "RENDEZVOUS"); + + NEST.INNER; + + FAILED("SHOULD HAVE RAISED 'TASKING_ERROR' IN 'SLAVE' " & + "TASK"); + EXCEPTION + WHEN TASKING_ERROR => + --COMMENT("'SLAVE' TASK CORRECTLY TRAPPING " & + -- "'TASKING_ERROR' AND RE-RAISING IT (BUT " & + -- "SHOULD NOT BE PROPAGATED)"); + RAISE; + END SLAVE; + + BEGIN -- START OF DRIVER PROCEDURE. + + --COMMENT("AT TOP OF 'DRIVER'. CALLING 'OUTER' ENTRY OF " & + -- "'NEST' TASK"); + + NEST.OUTER; + + --COMMENT("'OUTER' RENDEZVOUS COMPLETED. 'DRIVER' AWAITING " & + -- "TERMINATION OF 'NEST' AND 'SLAVE' TASKS"); + + EXCEPTION + WHEN TASKING_ERROR => + FAILED("'TASKING_ERROR' CAUGHT IN 'DRIVER' WHEN IT " & + "SHOULD HAVE BEEN CAUGHT IN 'SLAVE' TASK, OR " & + "'TASKING_ERROR' WAS INCORRECTLY PROPAGATED BY " & + "'SLAVE' TASK"); + END DRIVER; + +BEGIN -- START OF MAIN PROGRAM. + + TEST("C95040D","CHECK THAT 'TASKING_ERROR' IS RAISED IN A " & + "CALLER TASK WHEN TASK OWNING THE ENTRY CANNOT " & + "PERFORM RENDEZVOUS. ALSO CHECK THAT " & + "'TASKING_ERROR', ONCE RAISED, IS NOT PROPAGATED " & + "OUTSIDE THE TASK BODY"); + + --COMMENT("MAIN PROGRAM CALLING 'DRIVER' PROCEDURE"); + + DRIVER; + + --COMMENT("MAIN PROGRAM NOW TERMINATING"); + + RESULT; +END C95040D; |