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

   1 -- C94002E.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 A NON-MASTER UNIT, WHICH ALLOCATES TASKS OF A GLOBAL
  26 --   ACCESS TYPE, MUST TERMINATE WITHOUT WAITING FOR THE ALLOCATED TASKS
  27 --   TO TERMINATE.
  28
  29 -- SUBTESTS ARE:
  30 --   (A)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
  31 --   (B)  A RECORD OF TASK ALLOCATOR, IN A SUBPROGRAM.
  32 --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
  33
  34 -- JRK 10/8/81
  35 -- SPS 11/2/82
  36 -- SPS 11/21/82
  37 -- JRK 11/29/82
  38 -- TBN 1/20/86     RENAMED FROM C94006A-B.ADA.  LOWERED THE DELAY VALUES
  39 --                 AND MODIFIED THE COMMENTS.
  40 -- JRK 5/1/86      IMPROVED ERROR RECOVERY LOGIC.
  41 -- PWN 09/11/94    REMOVED PRAGMA PRIORITY FOR ADA 9X.
  42
  43 with Impdef;
  44 WITH REPORT; USE REPORT;
  45 WITH SYSTEM; USE SYSTEM;
  46 PROCEDURE C94002E IS
  47
  48      TASK TYPE TT IS
  49           ENTRY E;
  50      END TT;
  51
  52      TASK BODY TT IS
  53      BEGIN
  54           ACCEPT E;
  55           ACCEPT E;
  56      END TT;
  57
  58
  59 BEGIN
  60      TEST ("C94002E", "CHECK THAT A NON-MASTER UNIT, WHICH ALLOCATES " &
  61                       "TASKS OF A GLOBAL ACCESS TYPE, MUST TERMINATE " &
  62                       "WITHOUT WAITING FOR THE ALLOCATED TASKS TO " &
  63                       "TERMINATE");
  64
  65      --------------------------------------------------
  66
  67      DECLARE -- (A)
  68
  69           TYPE A_T IS ACCESS TT;
  70           A1 : A_T;
  71
  72      BEGIN -- (A)
  73
  74           DECLARE
  75                A2 : A_T;
  76           BEGIN
  77                A2 := NEW TT;
  78                A2.ALL.E;
  79                A1 := A2;
  80           END;
  81
  82           IF A1.ALL'TERMINATED THEN
  83                FAILED ("ALLOCATED TASK PREMATURELY TERMINATED - (A)");
  84           ELSE A1.ALL.E;
  85           END IF;
  86
  87      END; -- (A)
  88
  89      --------------------------------------------------
  90
  91      DECLARE -- (B)
  92
  93           I : INTEGER;
  94
  95           FUNCTION F RETURN INTEGER IS
  96
  97                TYPE RT IS
  98                     RECORD
  99                          T : TT;
 100                     END RECORD;
 101                TYPE ART IS ACCESS RT;
 102                AR1 : ART;
 103
 104                PROCEDURE P (AR : OUT ART) IS
 105                     AR2 : ART;
 106                BEGIN
 107                     AR2 := NEW RT;
 108                     AR2.T.E;
 109                     AR := AR2;
 110                END P;
 111
 112           BEGIN
 113                P (AR1);
 114
 115                IF AR1.T'TERMINATED THEN
 116                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
 117                             "- (B)");
 118                ELSE AR1.T.E;
 119                END IF;
 120
 121                RETURN 0;
 122           END F;
 123
 124      BEGIN -- (B)
 125
 126           I := F;
 127
 128      END; -- (B)
 129
 130      --------------------------------------------------
 131
 132      DECLARE -- (C)
 133
 134           LOOP_COUNT : INTEGER := 0;
 135           CUT_OFF : CONSTANT := 60;                -- DELAY.
 136
 137           TASK TSK IS
 138                ENTRY ENT;
 139           END TSK;
 140
 141           TASK BODY TSK IS
 142
 143                LOOP_COUNT1 : INTEGER := 0;
 144                CUT_OFF1 : CONSTANT := 60;          -- DELAY.
 145
 146                TYPE RAT;
 147                TYPE ARAT IS ACCESS RAT;
 148                TYPE ARR IS ARRAY (1..1) OF TT;
 149                TYPE RAT IS
 150                     RECORD
 151                          A : ARAT;
 152                          T : ARR;
 153                     END RECORD;
 154                ARA1 : ARAT;
 155
 156                TASK TSK1 IS
 157                     ENTRY ENT1 (ARA : OUT ARAT);
 158                END TSK1;
 159
 160                TASK BODY TSK1 IS
 161                     ARA2 : ARAT;
 162                BEGIN
 163                     ARA2 := NEW RAT;
 164                     ARA2.T(1).E;
 165                     ACCEPT ENT1 (ARA : OUT ARAT) DO
 166                          ARA := ARA2;
 167                     END ENT1;
 168                END TSK1;
 169
 170           BEGIN
 171                TSK1.ENT1 (ARA1);
 172
 173                WHILE NOT TSK1'TERMINATED AND LOOP_COUNT1 < CUT_OFF1 LOOP
 174                     DELAY 1.0 * Impdef.One_Second;
 175                     LOOP_COUNT1 := LOOP_COUNT1 + 1;
 176                END LOOP;
 177
 178                IF LOOP_COUNT1 >= CUT_OFF1 THEN
 179                     FAILED ("DEPENDENT TASK TSK1 NOT TERMINATED " &
 180                             "WITHIN ONE MINUTE - (C)");
 181                END IF;
 182
 183                IF ARA1.T(1)'TERMINATED THEN
 184                     FAILED ("ALLOCATED TASK PREMATURELY TERMINATED " &
 185                             "- (C)");
 186                ELSE ARA1.T(1).E;
 187                END IF;
 188           END TSK;
 189
 190      BEGIN -- (C)
 191
 192           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
 193                DELAY 2.0 * Impdef.One_Second;
 194                LOOP_COUNT := LOOP_COUNT + 1;
 195           END LOOP;
 196
 197           IF LOOP_COUNT >= CUT_OFF THEN
 198                FAILED ("DEPENDENT TASK TSK NOT TERMINATED WITHIN " &
 199                        "TWO MINUTES - (C)");
 200           END IF;
 201
 202      END; -- (C)
 203
 204      --------------------------------------------------
 205
 206      RESULT;
 207 END C94002E;