llvm-gcc-4.0/gcc/testsuite/ada/acats/tests/c9/c95040d.ada

-- 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;