gcc/testsuite/ada/acats/tests/c9/c974005.a

   1 -- C974005.A
   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 --
  26 -- OBJECTIVE:
  27 --      Check that Tasking_Error is raised at the point of an entry call
  28 --      which is the triggering statement of an asynchronous select, if
  29 --      the entry call is queued, but the task containing the entry completes
  30 --      before it can be accepted or canceled.
  31 --
  32 --      Check that the abortable part is aborted if it does not complete
  33 --      before the triggering statement completes.
  34 --
  35 --      Check that the sequence of statements of the triggering alternative
  36 --      is not executed.
  37 --
  38 -- TEST DESCRIPTION:
  39 --      Declare a main procedure containing an asynchronous select with a task
  40 --      entry call as triggering statement. Force the entry call to be
  41 --      queued by having the task call a procedure, prior to the corresponding
  42 --      accept statement, which simulates a routine waiting for user input
  43 --      (with a delay).
  44 --
  45 --      Simulate a time-consuming routine in the abortable part by calling a
  46 --      procedure containing an infinite loop. Meanwhile, simulate input by
  47 --      the user (the delay expires) which is NOT the input expected by the
  48 --      guard on the accept statement. The entry remains closed, and the
  49 --      task completes its execution. Since the entry was not accepted before
  50 --      its task completed, Tasking_Error is raised at the point of the entry
  51 --      call.
  52 --
  53 --
  54 -- CHANGE HISTORY:
  55 --      06 Dec 94   SAIC    ACVC 2.0
  56 --
  57 --!
  58
  59 package C974005_0 is  -- Automated teller machine abstraction.
  60
  61
  62    -- Flags for testing purposes:
  63
  64    Count : Integer := 1234;
  65
  66    type Key_Enum is (None, Cancel, Deposit, Withdraw);
  67
  68    type Card_Number_Type is private;
  69    type Card_PIN_Type    is private;
  70    type ATM_Card_Type    is private;
  71
  72
  73    Transaction_Canceled : exception;
  74
  75
  76    task type ATM_Keyboard_Task is
  77       entry Cancel_Pressed;
  78    end ATM_Keyboard_Task;
  79
  80
  81    procedure Read_Card (Card : in out ATM_Card_Type);
  82
  83    procedure Validate_Card (Card : in ATM_Card_Type);
  84
  85    procedure Perform_Transaction (Card : in ATM_Card_Type);
  86
  87 private
  88
  89    type Card_Number_Type is range   1 .. 9999;
  90    type Card_PIN_Type    is range 100 ..  999;
  91
  92    type ATM_Card_Type is record
  93       Number : Card_Number_Type;
  94       PIN    : Card_PIN_Type;
  95    end record;
  96
  97 end C974005_0;
  98
  99
 100      --==================================================================--
 101
 102
 103 with Report;
 104 with ImpDef;
 105
 106 package body C974005_0 is
 107
 108
 109    procedure Listen_For_Input (Key : out Key_Enum) is
 110    begin
 111       -- Simulate the situation where a user waits a bit for the card to
 112       -- be validated, then presses a transaction key (NOT Cancel).
 113
 114       -- Delay long enough to force queuing of Keyboard.Cancel_Pressed.
 115       delay ImpDef.Clear_Ready_Queue;
 116
 117       if Report.Equal (3, 3) then  -- Always true.
 118          Key := Deposit;           -- Cancel is NOT pressed.
 119       end if;
 120    end Listen_For_Input;
 121
 122
 123    task body ATM_Keyboard_Task is
 124       Key_Pressed : Key_Enum := None;
 125    begin
 126
 127       -- Note: no loop. If the user does not press Cancel, the task completes.
 128       -- In this model of the keyboard monitor, the user only gets one chance
 129       -- to cancel the card validation.
 130                                                             -- Force entry
 131          Listen_For_Input (Key_Pressed);                    -- calls to be
 132                                                             -- queued, but do
 133                                                             -- NOT set guard
 134                                                             -- to true.
 135       select
 136          when (Key_Pressed = Cancel) =>                     -- Guard is false,
 137             accept Cancel_Pressed do                        -- so entry call
 138                Report.Failed ("Accept statement executed"); -- remains queued.
 139             end Cancel_Pressed;
 140       else                                                  -- Else alternative
 141          Key_Pressed := None;                               -- executed, then
 142       end select;                                           -- task ends.
 143    exception
 144       when others =>
 145          Report.Failed ("Unexpected exception in ATM_Keyboard_Task");
 146    end ATM_Keyboard_Task;
 147
 148
 149
 150    procedure Read_Card (Card : in out ATM_Card_Type) is
 151    begin
 152       Card.Number := 9999;
 153       Card.PIN    := 111;
 154    end Read_Card;
 155
 156
 157    procedure Validate_Card (Card : in ATM_Card_Type) is
 158    begin
 159       -- Simulate an exceedingly long validation activity.
 160       loop                                             -- Infinite loop.
 161          Count := (Count + 1) mod Integer (Card.PIN);
 162
 163          -- Synch Point to allow transfer of control to Keyboard task
 164          -- during this simulation
 165          delay ImpDef.Minimum_Task_Switch;
 166
 167          exit when not Report.Equal (Count, Count);    -- Always false.
 168       end loop;
 169    end Validate_Card;
 170
 171
 172    procedure Perform_Transaction (Card : in ATM_Card_Type) is
 173    begin
 174       Report.Failed ("Exception not re-raised immediately following " &
 175                      "asynchronous select");
 176       if Count = 1234 then
 177          -- Additional analysis added to aid developers
 178          Report.Failed ("Abortable part did not execute");
 179       end if;
 180    end Perform_Transaction;
 181
 182
 183 end C974005_0;
 184
 185
 186      --==================================================================--
 187
 188
 189 with Report;
 190
 191 with C974005_0;  -- Automated teller machine abstraction.
 192 use  C974005_0;
 193
 194 procedure C974005 is
 195
 196    Card_Data : ATM_Card_Type;
 197
 198 begin  -- Main program.
 199
 200    Report.Test ("C974005", "ATC: trigger is queued but task terminates" &
 201                              " before call is serviced");
 202
 203    Read_Card (Card_Data);
 204
 205    begin
 206
 207       declare
 208          Keyboard : C974005_0.ATM_Keyboard_Task;
 209       begin
 210
 211          --                                    --
 212          -- Asynchronous select is tested here --
 213          --                                    --
 214
 215          select
 216             Keyboard.Cancel_Pressed;      -- Entry call initially queued, so
 217                                           -- abortable part starts.
 218
 219                                           -- Tasking_Error raised here when
 220                                           -- Keyboard completes before entry
 221                                           -- call can be accepted, and before
 222                                           -- abortable part completes.
 223
 224             raise Transaction_Canceled;   -- Should not be executed.
 225          then abort
 226             Validate_Card (Card_Data);    -- Keyboard task completes before
 227                                           -- Keyboard.Cancel_Pressed is
 228                                           -- accepted, and before this call
 229                                           -- finishes. Tasking_Error is raised
 230                                           -- at the point of the entry call,
 231                                           -- and this call is aborted.
 232             -- Check that the whole of the abortable part is aborted, not just
 233             -- the statement in the abortable part that was executing at
 234             -- the time
 235             Report.Failed ("Abortable part not aborted");
 236          end select;
 237          Perform_Transaction (Card_Data); -- Should not be reached.
 238       exception
 239          when Transaction_Canceled =>
 240             Report.Failed ("Triggering alternative sequence of statements " &
 241                            "executed");
 242          when Tasking_Error        =>
 243             if Count = 1234 then
 244                Report.Failed ("Abortable part did not execute");
 245             end if;
 246          when others       =>
 247             Report.Failed ("Wrong exception raised");
 248       end;
 249
 250    exception
 251       when Tasking_Error        =>
 252          Report.Failed ("Correct exception raised at wrong level");
 253       when others       =>
 254          Report.Failed ("Wrong exception raised at wrong level");
 255    end;
 256
 257    Report.Result;
 258
 259 end C974005;