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

   1 -- C97307A.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 TIMED ENTRY CALL THAT IS CANCELED (BECAUSE THE DELAY HAS
  26 -- EXPIRED) IS REMOVED FROM THE QUEUE OF THE CALLED TASK'S ENTRY.
  27
  28 -- WRG 7/14/86
  29
  30 with Impdef;
  31 WITH REPORT; USE REPORT;
  32 PROCEDURE C97307A IS
  33
  34 BEGIN
  35
  36      TEST ("C97307A", "CHECK THAT A TIMED ENTRY CALL THAT IS " &
  37                       "CANCELED (BECAUSE THE DELAY HAS EXPIRED) IS " &
  38                       "REMOVED FROM THE QUEUE OF THE CALLED TASK'S " &
  39                       "ENTRY");
  40
  41      DECLARE
  42
  43           DELAY_TIME : CONSTANT DURATION := 2 * 60.0 * Impdef.One_Second;
  44
  45           TASK EXPIRED IS
  46                ENTRY INCREMENT;
  47                ENTRY READ (COUNT : OUT NATURAL);
  48           END EXPIRED;
  49
  50           TASK TYPE NON_TIMED_CALLER IS
  51                ENTRY NAME (N : NATURAL);
  52           END NON_TIMED_CALLER;
  53
  54           TASK TYPE TIMED_CALLER IS
  55                ENTRY NAME (N : NATURAL);
  56           END TIMED_CALLER;
  57
  58           CALLER1 : TIMED_CALLER;
  59           CALLER2 : NON_TIMED_CALLER;
  60           CALLER3 : TIMED_CALLER;
  61           CALLER4 : NON_TIMED_CALLER;
  62           CALLER5 : TIMED_CALLER;
  63
  64           TASK T IS
  65                ENTRY E (NAME : NATURAL);
  66           END T;
  67
  68           TASK DISPATCH IS
  69                ENTRY READY;
  70           END DISPATCH;
  71
  72           --------------------------------------------------
  73
  74           TASK BODY EXPIRED IS
  75                EXPIRED_CALLS : NATURAL := 0;
  76           BEGIN
  77                LOOP
  78                     SELECT
  79                          ACCEPT INCREMENT DO
  80                               EXPIRED_CALLS := EXPIRED_CALLS + 1;
  81                          END INCREMENT;
  82                     OR
  83                          ACCEPT READ (COUNT : OUT NATURAL) DO
  84                               COUNT := EXPIRED_CALLS;
  85                          END READ;
  86                     OR
  87                          TERMINATE;
  88                     END SELECT;
  89                END LOOP;
  90           END EXPIRED;
  91
  92           --------------------------------------------------
  93
  94           TASK BODY NON_TIMED_CALLER IS
  95                MY_NAME : NATURAL;
  96           BEGIN
  97                ACCEPT NAME (N : NATURAL) DO
  98                     MY_NAME := N;
  99                END NAME;
 100
 101                T.E (MY_NAME);
 102           END NON_TIMED_CALLER;
 103
 104           --------------------------------------------------
 105
 106           TASK BODY TIMED_CALLER IS
 107                MY_NAME : NATURAL;
 108           BEGIN
 109                ACCEPT NAME (N : NATURAL) DO
 110                     MY_NAME := N;
 111                END NAME;
 112
 113                SELECT
 114                     T.E (MY_NAME);
 115                     FAILED ("TIMED ENTRY CALL NOT CANCELED FOR CALLER" &
 116                             NATURAL'IMAGE(MY_NAME));
 117                OR
 118                     DELAY DELAY_TIME;
 119                     EXPIRED.INCREMENT;
 120                END SELECT;
 121           EXCEPTION
 122                WHEN OTHERS =>
 123                     FAILED ("EXCEPTION RAISED IN TIMED_CALLER -- " &
 124                             "CALLER" & NATURAL'IMAGE(MY_NAME));
 125           END TIMED_CALLER;
 126
 127           --------------------------------------------------
 128
 129           TASK BODY DISPATCH IS
 130           BEGIN
 131                CALLER1.NAME (1);
 132                ACCEPT READY;
 133
 134                CALLER2.NAME (2);
 135                ACCEPT READY;
 136
 137                CALLER3.NAME (3);
 138                ACCEPT READY;
 139
 140                CALLER4.NAME (4);
 141                ACCEPT READY;
 142
 143                CALLER5.NAME (5);
 144           END DISPATCH;
 145
 146           --------------------------------------------------
 147
 148           TASK BODY T IS
 149
 150                DESIRED_QUEUE_LENGTH : NATURAL := 1;
 151                EXPIRED_CALLS        : NATURAL;
 152
 153                ACCEPTED             : ARRAY (1..5) OF NATURAL RANGE 0..5
 154                                          := (OTHERS => 0);
 155                ACCEPTED_INDEX       : NATURAL := 0;
 156
 157           BEGIN
 158                LOOP
 159                     LOOP
 160                          EXPIRED.READ (EXPIRED_CALLS);
 161                     EXIT WHEN E'COUNT >= DESIRED_QUEUE_LENGTH -
 162                                          EXPIRED_CALLS;
 163                          DELAY 2.0 * Impdef.One_Second;
 164                     END LOOP;
 165                EXIT WHEN DESIRED_QUEUE_LENGTH = 5;
 166                     DISPATCH.READY;
 167                     DESIRED_QUEUE_LENGTH := DESIRED_QUEUE_LENGTH + 1;
 168                END LOOP;
 169
 170                -- AT THIS POINT, FIVE TASKS WERE QUEUED.
 171                -- LET THE TIMED ENTRY CALLS ISSUED BY CALLER1,
 172                -- CALLER3, AND CALLER5 EXPIRE:
 173
 174                DELAY DELAY_TIME + 10.0 * Impdef.One_Second;
 175
 176                -- AT THIS POINT, ALL THE TIMED ENTRY CALLS MUST HAVE
 177                -- EXPIRED AND BEEN REMOVED FROM THE ENTRY QUEUE FOR E,
 178                -- OTHERWISE THE IMPLEMENTATION HAS FAILED THIS TEST.
 179
 180                WHILE E'COUNT > 0 LOOP
 181                     ACCEPT E (NAME : NATURAL) DO
 182                          ACCEPTED_INDEX := ACCEPTED_INDEX + 1;
 183                          ACCEPTED (ACCEPTED_INDEX) := NAME;
 184                     END E;
 185                END LOOP;
 186
 187                IF ACCEPTED /= (2, 4, 0, 0, 0) THEN
 188                     FAILED ("SOME TIMED CALLS NOT REMOVED FROM ENTRY " &
 189                             "QUEUE");
 190                     COMMENT ("ORDER ACCEPTED WAS:" &
 191                              NATURAL'IMAGE (ACCEPTED (1))  & ',' &
 192                              NATURAL'IMAGE (ACCEPTED (2))  & ',' &
 193                              NATURAL'IMAGE (ACCEPTED (3))  & ',' &
 194                              NATURAL'IMAGE (ACCEPTED (4))  & ',' &
 195                              NATURAL'IMAGE (ACCEPTED (5)) );
 196                END IF;
 197           END T;
 198
 199           --------------------------------------------------
 200
 201      BEGIN
 202
 203           NULL;
 204
 205      END;
 206
 207      RESULT;
 208
 209 END C97307A;