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

   1 -- C94002A.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 UNIT WITH DEPENDENT TASKS CREATED BY (LOCAL)
  26 --   ALLOCATORS DOES NOT TERMINATE UNTIL ALL DEPENDENT TASKS ARE
  27 --   TERMINATED.
  28 -- SUBTESTS ARE:
  29 --   (A, B)  A SIMPLE TASK ALLOCATOR, IN A BLOCK.
  30 --   (C, D)  A RECORD OF TASK ALLOCATOR, IN A FUNCTION.
  31 --   (E, F)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A TASK BODY.
  32
  33 -- THIS TEST CONTAINS SHARED VARIABLES AND RACE CONDITIONS.
  34
  35 -- JRK 10/2/81
  36 -- SPS 11/2/82
  37 -- SPS 11/21/82
  38 -- JRK 11/29/82
  39 -- TBN  8/25/86     REDUCED DELAYS; ADDED LIMITED PRIVATE TYPES;
  40 --                  INCLUDED EXITS BY RAISING AN EXCEPTION.
  41 -- PWN 01/31/95     REMOVED PRAGMA PRIORITY FOR ADA 9X.
  42
  43 with Impdef;
  44 WITH REPORT; USE REPORT;
  45 WITH SYSTEM; USE SYSTEM;
  46 PROCEDURE C94002A IS
  47
  48      PACKAGE P IS
  49           MY_EXCEPTION : EXCEPTION;
  50           GLOBAL : INTEGER;
  51           TASK TYPE T1 IS
  52                ENTRY E (I : INTEGER);
  53           END T1;
  54           TYPE T2 IS LIMITED PRIVATE;
  55           PROCEDURE CALL_ENTRY (A : T2; B : INTEGER);
  56      PRIVATE
  57           TASK TYPE T2 IS
  58                ENTRY E (I : INTEGER);
  59           END T2;
  60      END P;
  61
  62      PACKAGE BODY P IS
  63           TASK BODY T1 IS
  64                LOCAL : INTEGER;
  65           BEGIN
  66                ACCEPT E (I : INTEGER) DO
  67                     LOCAL := I;
  68                END E;
  69                DELAY 30.0 * Impdef.One_Second;    -- SINCE THE PARENT UNIT HAS HIGHER
  70                               -- PRIORITY AT THIS POINT, IT WILL
  71                               -- RECEIVE CONTROL AND TERMINATE IF
  72                               -- THE ERROR IS PRESENT.
  73                GLOBAL := LOCAL;
  74           END T1;
  75
  76           TASK BODY T2 IS
  77                LOCAL : INTEGER;
  78           BEGIN
  79                ACCEPT E (I : INTEGER) DO
  80                     LOCAL := I;
  81                END E;
  82                DELAY 30.0 * Impdef.One_Second;
  83                GLOBAL := LOCAL;
  84           END T2;
  85
  86           PROCEDURE CALL_ENTRY (A : T2; B : INTEGER) IS
  87           BEGIN
  88                A.E (B);
  89           END CALL_ENTRY;
  90      END P;
  91
  92      USE P;
  93
  94
  95 BEGIN
  96      TEST ("C94002A", "CHECK THAT A UNIT WITH DEPENDENT TASKS " &
  97                       "CREATED BY (LOCAL) ALLOCATORS DOES NOT " &
  98                       "TERMINATE UNTIL ALL DEPENDENT TASKS " &
  99                       "ARE TERMINATED");
 100
 101      --------------------------------------------------
 102      GLOBAL := IDENT_INT (0);
 103      BEGIN -- (A)
 104           DECLARE
 105                TYPE A_T IS ACCESS T1;
 106                A : A_T;
 107           BEGIN
 108                IF EQUAL (3, 3) THEN
 109                     A := NEW T1;
 110                     A.ALL.E (IDENT_INT(1));
 111                     RAISE MY_EXCEPTION;
 112                END IF;
 113           END;
 114
 115           FAILED ("MY_EXCEPTION WAS NOT RAISED - 1");
 116      EXCEPTION
 117           WHEN MY_EXCEPTION =>
 118                IF GLOBAL /= 1 THEN
 119                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
 120                             "BLOCK EXIT - 1");
 121                END IF;
 122           WHEN OTHERS =>
 123                FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
 124      END; -- (A)
 125
 126      --------------------------------------------------
 127
 128      GLOBAL := IDENT_INT (0);
 129
 130      DECLARE -- (B)
 131           TYPE A_T IS ACCESS T2;
 132           A : A_T;
 133      BEGIN -- (B)
 134           IF EQUAL (3, 3) THEN
 135                A := NEW T2;
 136                CALL_ENTRY (A.ALL, IDENT_INT(2));
 137           END IF;
 138      END; -- (B)
 139
 140      IF GLOBAL /= 2 THEN
 141           FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
 142                   "BLOCK EXIT - 2");
 143      END IF;
 144
 145      --------------------------------------------------
 146
 147      GLOBAL := IDENT_INT (0);
 148
 149      DECLARE -- (C)
 150           I : INTEGER;
 151
 152           FUNCTION F RETURN INTEGER IS
 153                TYPE RT;
 154                TYPE ART IS ACCESS RT;
 155                TYPE RT IS
 156                     RECORD
 157                          A : ART;
 158                          T : T1;
 159                     END RECORD;
 160                LIST : ART;
 161                TEMP : ART;
 162           BEGIN
 163                FOR I IN 1 .. IDENT_INT (1) LOOP
 164                     TEMP := NEW RT;
 165                     TEMP.A := LIST;
 166                     LIST := TEMP;
 167                     LIST.T.E (IDENT_INT(3));
 168                END LOOP;
 169                RETURN 0;
 170           END F;
 171      BEGIN -- (C)
 172           I := F;
 173
 174           IF GLOBAL /= 3 THEN
 175                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
 176                        "FUNCTION EXIT - 3");
 177           END IF;
 178      END; -- (C)
 179
 180      --------------------------------------------------
 181
 182      GLOBAL := IDENT_INT (0);
 183
 184      DECLARE -- (D)
 185           I : INTEGER;
 186
 187           FUNCTION F RETURN INTEGER IS
 188                TYPE RT;
 189                TYPE ART IS ACCESS RT;
 190                TYPE RT IS
 191                     RECORD
 192                          A : ART;
 193                          T : T2;
 194                     END RECORD;
 195                LIST : ART;
 196                TEMP : ART;
 197           BEGIN
 198                FOR I IN 1 .. IDENT_INT (1) LOOP
 199                     TEMP := NEW RT;
 200                     TEMP.A := LIST;
 201                     LIST := TEMP;
 202                     CALL_ENTRY (LIST.T, IDENT_INT(4));
 203                     IF EQUAL (3, 3) THEN
 204                          RAISE MY_EXCEPTION;
 205                     END IF;
 206                END LOOP;
 207                RETURN 0;
 208           END F;
 209      BEGIN -- (D)
 210           I := F;
 211
 212           FAILED ("MY_EXCEPTION WAS NOT RAISED - 4");
 213      EXCEPTION
 214           WHEN MY_EXCEPTION =>
 215                IF GLOBAL /= 4 THEN
 216                     FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
 217                             "FUNCTION EXIT - 4");
 218                END IF;
 219           WHEN OTHERS =>
 220                FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
 221      END; -- (D)
 222
 223      --------------------------------------------------
 224
 225      GLOBAL := IDENT_INT (0);
 226
 227      DECLARE -- (E)
 228
 229           LOOP_COUNT : INTEGER := 0;
 230           CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
 231
 232           TASK TSK IS
 233                ENTRY ENT;
 234           END TSK;
 235
 236           TASK BODY TSK IS
 237                TYPE ARR IS ARRAY (1..1) OF T1;
 238                TYPE RAT;
 239                TYPE ARAT IS ACCESS RAT;
 240                TYPE RAT IS
 241                     RECORD
 242                          A : ARAT;
 243                          T : ARR;
 244                     END RECORD;
 245                LIST : ARAT;
 246                TEMP : ARAT;
 247           BEGIN
 248                FOR I IN 1 .. IDENT_INT (1) LOOP
 249                     TEMP := NEW RAT;
 250                     TEMP.A := LIST;
 251                     LIST := TEMP;
 252                     LIST.T(1).E (IDENT_INT(5));
 253                     IF EQUAL (3, 3) THEN
 254                          RAISE MY_EXCEPTION;
 255                     END IF;
 256                END LOOP;
 257           END TSK;
 258
 259      BEGIN -- (E)
 260
 261           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
 262                DELAY 1.0 * Impdef.One_Second;
 263                LOOP_COUNT := LOOP_COUNT + 1;
 264           END LOOP;
 265
 266           IF LOOP_COUNT >= CUT_OFF THEN
 267                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
 268                        "MINUTES - 5");
 269           END IF;
 270
 271           IF GLOBAL /= 5 THEN
 272                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
 273                        "TASK EXIT - 5");
 274           END IF;
 275
 276      END; -- (E)
 277
 278      --------------------------------------------------
 279
 280      GLOBAL := IDENT_INT (0);
 281
 282      DECLARE -- (F)
 283
 284           LOOP_COUNT : INTEGER := 0;
 285           CUT_OFF : CONSTANT := 5 * 60;     -- FIVE MINUTE DELAY.
 286
 287           TASK TSK IS
 288                ENTRY ENT;
 289           END TSK;
 290
 291           TASK BODY TSK IS
 292                TYPE ARR IS ARRAY (1..1) OF T2;
 293                TYPE RAT;
 294                TYPE ARAT IS ACCESS RAT;
 295                TYPE RAT IS
 296                     RECORD
 297                          A : ARAT;
 298                          T : ARR;
 299                     END RECORD;
 300                LIST : ARAT;
 301                TEMP : ARAT;
 302           BEGIN
 303                FOR I IN 1 .. IDENT_INT (1) LOOP
 304                     TEMP := NEW RAT;
 305                     TEMP.A := LIST;
 306                     LIST := TEMP;
 307                     CALL_ENTRY (LIST.T(1), IDENT_INT(6));
 308                END LOOP;
 309           END TSK;
 310
 311      BEGIN -- (F)
 312
 313           WHILE NOT TSK'TERMINATED AND LOOP_COUNT < CUT_OFF LOOP
 314                DELAY 1.0 * Impdef.One_Second;
 315                LOOP_COUNT := LOOP_COUNT + 1;
 316           END LOOP;
 317
 318           IF LOOP_COUNT >= CUT_OFF THEN
 319                FAILED ("DEPENDENT TASK NOT TERMINATED WITHIN FIVE " &
 320                        "MINUTES - 6");
 321           END IF;
 322
 323           IF GLOBAL /= 6 THEN
 324                FAILED ("DEPENDENT TASK NOT TERMINATED BEFORE " &
 325                        "TASK EXIT - 6");
 326           END IF;
 327
 328      END; -- (F)
 329
 330      RESULT;
 331 END C94002A;