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

   1 -- C94007B.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 TASK THAT IS ALLOCATED IN A NON-LIBRARY PACKAGE
  26 --   (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
  27 --   BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
  28 --   OR TASK BODY.
  29 -- SUBTESTS ARE:
  30 --   (A)  A SIMPLE TASK ALLOCATOR, IN A VISIBLE PART, IN A BLOCK.
  31 --   (B)  A RECORD OF TASK ALLOCATOR, IN A PRIVATE PART, IN A FUNCTION.
  32 --   (C)  A RECORD OF ARRAY OF TASK ALLOCATOR, IN A PACKAGE BODY,
  33 --           IN A TASK BODY.
  34
  35 -- JRK 10/16/81
  36 -- SPS 11/2/82
  37 -- PWN 01/31/95  REMOVED PRAGMA PRIORITY FOR ADA 9X.
  38
  39 with Impdef;
  40 WITH REPORT; USE REPORT;
  41 WITH SYSTEM; USE SYSTEM;
  42 PROCEDURE C94007B IS
  43
  44      TASK TYPE SYNC IS
  45           ENTRY ID (C : CHARACTER);
  46           ENTRY INNER;
  47           ENTRY OUTER;
  48      END SYNC;
  49
  50      TASK BODY SYNC IS
  51           ID_C : CHARACTER;
  52      BEGIN
  53           ACCEPT ID (C : CHARACTER) DO
  54                ID_C := C;
  55           END ID;
  56           DELAY 1.0 * Impdef.One_Second;
  57           SELECT
  58                ACCEPT OUTER;
  59           OR
  60                DELAY 120.0 * Impdef.One_Second;
  61                FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
  62           END SELECT;
  63           ACCEPT INNER;
  64      END SYNC;
  65
  66
  67 BEGIN
  68      TEST ("C94007B", "CHECK THAT A TASK THAT IS ALLOCATED IN A " &
  69                       "NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
  70                       "DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
  71                       "THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
  72                       "BODY, OR TASK BODY");
  73
  74      --------------------------------------------------
  75
  76      DECLARE -- (A)
  77
  78           S : SYNC;
  79
  80      BEGIN -- (A)
  81
  82           S.ID ('A');
  83
  84           DECLARE
  85
  86                PACKAGE PKG IS
  87                     TASK TYPE TT IS
  88                          ENTRY E;
  89                     END TT;
  90                     TYPE A_T IS ACCESS TT;
  91                     A : A_T;
  92                END PKG;
  93
  94                PACKAGE BODY PKG IS
  95                     TASK BODY TT IS
  96                     BEGIN
  97                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
  98                     END TT;
  99                BEGIN
 100                     A := NEW TT;
 101                END PKG;            -- PROBABLE OUTER BLOCK POINT.
 102
 103           BEGIN
 104
 105                S.OUTER;
 106
 107           EXCEPTION
 108                WHEN TASKING_ERROR => NULL;
 109           END;
 110
 111      END; -- (A)
 112
 113      --------------------------------------------------
 114
 115      DECLARE -- (B)
 116
 117           S : SYNC;
 118
 119           I : INTEGER;
 120
 121           FUNCTION F RETURN INTEGER IS
 122
 123                PACKAGE PKG IS
 124                PRIVATE
 125                     TASK TYPE TT IS
 126                          ENTRY E;
 127                     END TT;
 128
 129                     TYPE RT IS
 130                          RECORD
 131                               T : TT;
 132                          END RECORD;
 133
 134                     TYPE ART IS ACCESS RT;
 135
 136                     AR : ART;
 137                END PKG;
 138
 139                PACKAGE BODY PKG IS
 140                     TASK BODY TT IS
 141                     BEGIN
 142                          S.INNER;  -- PROBABLE INNER BLOCK POINT.
 143                     END TT;
 144                BEGIN
 145                     AR := NEW RT;
 146                END PKG;            -- PROBABLE OUTER BLOCK POINT.
 147
 148           BEGIN -- F
 149
 150                S.OUTER;
 151                RETURN 0;
 152
 153           EXCEPTION
 154                WHEN TASKING_ERROR => RETURN 0;
 155           END F;
 156
 157      BEGIN -- (B)
 158
 159           S.ID ('B');
 160           I := F ;
 161
 162      END; -- (B)
 163
 164      --------------------------------------------------
 165
 166      DECLARE -- (C)
 167
 168           S : SYNC;
 169
 170      BEGIN -- (C)
 171
 172           S.ID ('C');
 173
 174           DECLARE
 175
 176                TASK TSK IS
 177                END TSK;
 178
 179                TASK BODY TSK IS
 180
 181                     PACKAGE PKG IS
 182                     END PKG;
 183
 184                     PACKAGE BODY PKG IS
 185                          TASK TYPE TT IS
 186                               ENTRY E;
 187                          END TT;
 188
 189                          TYPE ARR IS ARRAY (1..1) OF TT;
 190                          TYPE RAT IS
 191                               RECORD
 192                                    T : ARR;
 193                               END RECORD;
 194
 195                          TYPE ARAT IS ACCESS RAT;
 196
 197                          ARA : ARAT;
 198
 199                          TASK BODY TT IS
 200                          BEGIN
 201                               S.INNER;  -- PROBABLE INNER BLOCK POINT.
 202                          END TT;
 203                     BEGIN
 204                          ARA := NEW RAT;
 205                     END PKG;            -- PROBABLE OUTER BLOCK POINT.
 206
 207                BEGIN -- TSK
 208
 209                     S.OUTER;
 210
 211                EXCEPTION
 212                     WHEN TASKING_ERROR => NULL;
 213                END TSK;
 214
 215           BEGIN
 216                NULL;
 217           END;
 218
 219      END; -- (C)
 220
 221      --------------------------------------------------
 222
 223      RESULT;
 224 END C94007B;