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

   1 -- C93001A.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 DECLARED TASK OBJECTS ARE NOT ACTIVATED BEFORE
  26 --   THE END OF THE DECLARATIVE PART.
  27 -- SUBTESTS ARE:
  28 --   (A)  A SIMPLE TASK OBJECT, IN A BLOCK.
  29 --   (B)  AN ARRAY OF TASK OBJECT, IN A FUNCTION.
  30 --   (C)  A RECORD OF TASK OBJECT, IN A PACKAGE SPECIFICATION.
  31 --   (D)  A RECORD OF ARRAY OF TASK OBJECT, IN A PACKAGE BODY.
  32 --   (E)  AN ARRAY OF RECORD OF TASK OBJECT, IN A TASK BODY.
  33
  34 -- THIS TEST ASSUMES THAT ACTIVATION IS A SEQUENTIAL STEP
  35 --   IN THE FLOW OF CONTROL OF THE PARENT (AS IS REQUIRED BY THE
  36 --   ADA RM).  IF AN IMPLEMENTATION (ILLEGALLY) ACTIVATES A
  37 --   TASK IN PARALLEL WITH ITS PARENT, THIS TEST
  38 --   IS NOT GUARANTEED TO DETECT THE VIOLATION, DUE TO A
  39 --   RACE CONDITION.
  40
  41 -- JRK 9/23/81
  42 -- SPS 11/1/82
  43 -- SPS 11/21/82
  44 -- R.WILLIAMS 10/8/86  ADDED CHECKS ON INITIALIZATIONS OF NON-TASK
  45 --                     COMPONENTS OF RECORD TYPES.
  46 -- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
  47
  48 WITH REPORT; USE REPORT;
  49 WITH SYSTEM; USE SYSTEM;
  50 PROCEDURE C93001A IS
  51
  52      GLOBAL : INTEGER;
  53
  54      FUNCTION SIDE_EFFECT (I : INTEGER) RETURN INTEGER IS
  55      BEGIN
  56           GLOBAL := IDENT_INT (I);
  57           RETURN 0;
  58      END SIDE_EFFECT;
  59
  60      TASK TYPE TT IS
  61           ENTRY E;
  62      END TT;
  63
  64      TASK BODY TT IS
  65           I : INTEGER := SIDE_EFFECT (1);
  66      BEGIN
  67           NULL;
  68      END TT;
  69
  70
  71 BEGIN
  72      TEST ("C93001A", "CHECK THAT DECLARED TASK OBJECTS ARE NOT " &
  73                       "ACTIVATED BEFORE THE END OF THE DECLARATIVE " &
  74
  75                       "PART");
  76
  77      --------------------------------------------------
  78
  79      GLOBAL := IDENT_INT (0);
  80
  81      DECLARE -- (A)
  82
  83           T : TT;
  84           I : INTEGER := GLOBAL;
  85
  86      BEGIN -- (A)
  87
  88           IF I /= 0 THEN
  89                FAILED ("A SIMPLE TASK OBJECT IN A BLOCK WAS " &
  90                        "ACTIVATED TOO SOON - (A)");
  91           END IF;
  92
  93      END; -- (A)
  94
  95      --------------------------------------------------
  96
  97      GLOBAL := IDENT_INT (0);
  98
  99      DECLARE -- (B)
 100
 101           J : INTEGER;
 102
 103           FUNCTION F RETURN INTEGER IS
 104                A : ARRAY (1..1) OF TT;
 105                I : INTEGER := GLOBAL;
 106           BEGIN
 107                IF I /= 0 THEN
 108                     FAILED ("AN ARRAY OF TASK OBJECT IN A FUNCTION " &
 109                             "WAS ACTIVATED TOO SOON - (B)");
 110                END IF;
 111                RETURN 0;
 112           END F;
 113
 114      BEGIN -- (B)
 115
 116           J := F ;
 117
 118      END; -- (B)
 119
 120      --------------------------------------------------
 121
 122      GLOBAL := IDENT_INT (0);
 123
 124      DECLARE -- (C)
 125
 126           PACKAGE P IS
 127
 128                TYPE REC IS
 129                     RECORD
 130                          T  : TT;
 131                          N1 : INTEGER := GLOBAL;
 132                     END RECORD;
 133
 134                TYPE RT IS
 135                     RECORD
 136                          M : INTEGER := GLOBAL;
 137                          T : TT;
 138                          N : REC;
 139                     END RECORD;
 140                R : RT;
 141                I : INTEGER := GLOBAL;
 142           END P;
 143
 144           PACKAGE Q IS
 145                J : INTEGER;
 146           PRIVATE
 147                TYPE RT IS
 148                     RECORD
 149                          N : P.REC;
 150                          T : TT;
 151                          M : INTEGER := GLOBAL;
 152                     END RECORD;
 153                R : RT;
 154           END Q;
 155
 156           K : INTEGER := GLOBAL;
 157
 158           PACKAGE BODY Q IS
 159           BEGIN
 160                IF R.M /= 0  OR R.N.N1 /= 0 THEN
 161                     FAILED ( "NON-TASK COMPONENTS OF RECORD R NOT " &
 162                              "INITIALIZED BEFORE TASKS ACTIVATED " &
 163                              "- (C.1)" );
 164                END IF;
 165           END Q;
 166
 167      BEGIN -- (C)
 168
 169           IF P.R.M /= 0 OR P.R.N.N1 /= 0 THEN
 170                FAILED ( "NON-TASK COMPONENTS OF RECORDS NOT " &
 171                         "INITIALIZED BEFORE TASKS ACTIVATED " &
 172                         "- (C.2)" );
 173           END IF;
 174
 175           IF P.I /= 0 OR K /= 0 THEN
 176                FAILED ("A RECORD OF TASK OBJECT IN A PACKAGE " &
 177                        "SPECIFICATION WAS ACTIVATED TOO SOON - (C)");
 178           END IF;
 179
 180      END; -- (C)
 181
 182      --------------------------------------------------
 183
 184      GLOBAL := IDENT_INT (0);
 185
 186      DECLARE -- (D)
 187
 188           PACKAGE P IS
 189
 190                TYPE GRADE IS (GOOD, FAIR, POOR);
 191
 192                TYPE REC (G : GRADE) IS
 193                     RECORD
 194                          NULL;
 195                     END RECORD;
 196
 197                TYPE ACCR IS ACCESS REC;
 198                TYPE ACCI IS ACCESS INTEGER;
 199
 200                TYPE ARR IS ARRAY (1..1) OF TT;
 201                TYPE RAT IS
 202                     RECORD
 203                          M : ACCR := NEW REC (GRADE'VAL (GLOBAL));
 204                          A : ARR;
 205                          N : ACCI := NEW INTEGER'(GLOBAL);
 206                     END RECORD;
 207                RA1 : RAT;
 208           PRIVATE
 209                RA2 : RAT;
 210           END P;
 211
 212           PACKAGE BODY P IS
 213                RA3 : RAT;
 214                I : INTEGER := GLOBAL;
 215           BEGIN
 216                IF RA1.M.G /= GOOD  OR RA1.N.ALL /= 0 THEN
 217                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA1 NOT " &
 218                              "INITIALIZED BEFORE TASKS ACTIVATED " &
 219                              "- (D)" );
 220                END IF;
 221
 222                IF RA2.M.G /= GOOD  OR RA2.N.ALL /= 0 THEN
 223                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA2 NOT " &
 224                              "INITIALIZED BEFORE TASKS ACTIVATED " &
 225                              "- (D)" );
 226                END IF;
 227
 228                IF RA3.M.G /= GOOD  OR RA3.N.ALL /= 0 THEN
 229                     FAILED ( "NON-TASK COMPONENTS OF RECORD RA3 NOT " &
 230                              "INITIALIZED BEFORE TASKS ACTIVATED " &
 231                              "- (D)" );
 232                END IF;
 233
 234                IF I /= 0 THEN
 235                     FAILED ("A RECORD OF ARRAY OF TASK OBJECT IN A " &
 236                             "PACKAGE SPEC OR BODY WAS ACTIVATED " &
 237                             "TOO SOON - (D)");
 238                END IF;
 239           END P;
 240
 241      BEGIN -- (D)
 242
 243           NULL;
 244
 245      END; -- (D)
 246
 247      --------------------------------------------------
 248
 249      GLOBAL := IDENT_INT (0);
 250
 251      DECLARE -- (E)
 252
 253           TYPE REC IS
 254                RECORD
 255                     B : BOOLEAN := BOOLEAN'VAL (GLOBAL);
 256                     T : TT;
 257                     C :CHARACTER :=CHARACTER'VAL (GLOBAL);
 258                END RECORD;
 259
 260           TASK T IS
 261                ENTRY E;
 262           END T;
 263
 264           TASK BODY T IS
 265                TYPE RT IS
 266                     RECORD
 267                          M : REC;
 268                          T : TT;
 269                          N : REC;
 270                     END RECORD;
 271                AR : ARRAY (1..1) OF RT;
 272                I : INTEGER := GLOBAL;
 273           BEGIN
 274                IF AR (1).M.B /= FALSE OR AR (1).M.C /= ASCII.NUL OR
 275                   AR (1).N.B /= FALSE OR AR (1).N.C /= ASCII.NUL THEN
 276                     FAILED ( "NON-TASK COMPONENTS OF RECORD RT NOT " &
 277                              "INITIALIZED BEFORE TASKS ACTIVATED " &
 278                              "- (E)" );
 279                END IF;
 280
 281                IF I /= 0 THEN
 282                     FAILED ("AN ARRAY OF RECORD OF TASK OBJECT IN A " &
 283                             "TASK BODY WAS ACTIVATED TOO SOON - (E)");
 284                END IF;
 285           END T;
 286
 287      BEGIN -- (E)
 288
 289           NULL;
 290
 291      END; -- (E)
 292
 293      --------------------------------------------------
 294
 295      RESULT;
 296 END C93001A;