gcc/testsuite/ada/acats/tests/c9/c93004d.ada

   1 -- C93004D.ADA
   2
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 -- CHECK THAT WHEN AN EXCEPTION IS RAISED DURING THE ACTIVATION OF A
  26 -- TASK, OTHER TASKS ARE UNAFFECTED.
  27
  28 -- THIS TEST CHECKS THE CASE IN WHICH SOME OF THE OTHER TASKS ARE
  29 -- PERHAPS ACTIVATED BEFORE THE EXCEPTION OCCURS AND SOME TASKS ARE
  30 -- PERHAPS ACTIVATED AFTER.
  31
  32 -- THE ENCLOSING BLOCK RECEIVES TASKING_ERROR.
  33
  34 -- CHECK THAT TASKS WAITING FOR ENTRIES OF SUCH TASKS RECEIVE
  35 -- TASKING_ERROR.
  36
  37 -- R. WILLIAMS 8/6/86
  38 -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
  39
  40 WITH SYSTEM; USE SYSTEM;
  41 WITH REPORT; USE REPORT;
  42 PROCEDURE C93004D IS
  43
  44
  45 BEGIN
  46      TEST ( "C93004D", "CHECK THAT WHEN AN EXCEPTION IS RAISED " &
  47                        "DURING ACTIVATION OF A TASK, OTHER TASKS " &
  48                        "ARE NOT AFFECTED. IN THIS TEST, SOME OF THE " &
  49                        "TASKS ARE PERHAPS ACTIVATED BEFORE THE " &
  50                        "EXCEPTION OCCURS AND SOME PERHAPS AFTER" );
  51
  52
  53      DECLARE
  54
  55           TASK T0 IS
  56                ENTRY E;
  57           END T0;
  58
  59           TASK TYPE T1 IS
  60           END T1;
  61
  62           TASK TYPE T2 IS
  63                ENTRY E;
  64           END T2;
  65
  66           ARR_T2: ARRAY(INTEGER RANGE 1..4) OF T2;
  67
  68           TYPE AT1 IS ACCESS T1;
  69
  70           TASK BODY T0 IS
  71           BEGIN
  72                ACCEPT E;
  73           END T0;
  74
  75           PACKAGE START_T1 IS      -- THIS PACKAGE TO AVOID ACCESS
  76           END START_T1;            -- BEFORE ELABORATION ON T1.
  77
  78           TASK BODY T1 IS
  79           BEGIN
  80                DECLARE   -- THIS BLOCK TO CHECK THAT T1BIS TERMINATES.
  81                     TASK T1BIS IS
  82                     END T1BIS;
  83
  84                     TASK BODY T1BIS IS
  85                     BEGIN
  86                          ARR_T2(IDENT_INT(2)).E;
  87                          FAILED ("RENDEZVOUS COMPLETED - T3");
  88                     EXCEPTION
  89                          WHEN TASKING_ERROR =>
  90                               NULL;
  91                          WHEN OTHERS =>
  92                               FAILED("ABNORMAL EXCEPTION - T3");
  93                     END T1BIS;
  94                BEGIN
  95                     NULL;
  96                END;
  97
  98                ARR_T2(IDENT_INT(2)).E;   -- ARR_T2(2) IS NOW
  99                                          -- TERMINATED.
 100
 101                FAILED ("RENDEZVOUS COMPLETED WITHOUT ERROR - T1");
 102
 103           EXCEPTION
 104                WHEN TASKING_ERROR =>
 105                     NULL;
 106                WHEN OTHERS =>
 107                     FAILED("ABNORMAL EXCEPTION - T1");
 108           END;
 109
 110           PACKAGE BODY START_T1 IS
 111                V_AT1 : AT1 := NEW T1;
 112           END START_T1;
 113
 114           TASK BODY T2 IS
 115                I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.
 116           BEGIN
 117                IF I /= IDENT_INT(2) OR I = IDENT_INT(1) + 1 THEN
 118                     FAILED("T2 ACTIVATED OK");
 119                END IF;
 120           END T2;
 121
 122           TASK T3 IS
 123                ENTRY E;
 124           END T3;
 125
 126           TASK BODY T3 IS
 127           BEGIN     -- T3 MUST BE ACTIVATED OK.
 128                ACCEPT E;
 129           END T3;
 130
 131      BEGIN -- T0, ARR_T2 (1 .. 4), T3 ACTIVATED HERE.
 132
 133           FAILED ("TASKING_ERROR NOT RAISED IN MAIN");
 134           T3.E;          -- CLEAN UP.
 135           T0.E;
 136      EXCEPTION
 137           WHEN TASKING_ERROR =>
 138                BEGIN
 139                     T3.E;
 140                     T0.E;
 141                EXCEPTION
 142                     WHEN TASKING_ERROR =>
 143                          FAILED ("T0 OR T3 NOT ACTIVATED");
 144                END;
 145           WHEN CONSTRAINT_ERROR =>
 146                FAILED ("CONSTRAINT_ERROR RAISED IN MAIN");
 147           WHEN OTHERS =>
 148                FAILED ("ABNORMAL EXCEPTION IN MAIN-2");
 149      END;
 150
 151      RESULT;
 152 END C93004D;