old-autovect-branch/gcc/testsuite/ada/acats/tests/c9/c974011.a

   1 -- C974011.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 the sequence of statements of the triggering alternative
  28 --      of an asynchronous select statement is not executed if the triggering
  29 --      statement is a task entry call and the entry is not accepted
  30 --      before the abortable part completes.
  31 --      Check that the call queued on the entry is cancelled
  32 --
  33 -- TEST DESCRIPTION:
  34 --      Declare a main procedure containing an asynchronous select with a task
  35 --      entry call as triggering statement. Force the entry call to be
  36 --      queued by having the task call a procedure, prior to the corresponding
  37 --      accept statement, which simulates (with a delay) a routine waiting
  38 --      for user input
  39 --
  40 --      Once the call is known to be queued, complete the abortable part.
  41 --      Check that the rendezvous (and thus the trigger) does not complete.
  42 --      Then clear the barrier and check that the entry has been cancelled
  43 --
  44 --
  45 -- CHANGE HISTORY:
  46 --      06 Dec 94   SAIC    ACVC 2.0
  47 --      28 Nov 95   SAIC    Eliminated shared global variable for ACVC 2.0.1
  48 --
  49 --!
  50
  51 with ImpDef;
  52 --
  53 package C974011_0 is  -- Automated teller machine abstraction.
  54
  55
  56
  57    type Key_Enum is (None, Cancel, Deposit, Withdraw);
  58
  59    protected Key_PO is
  60       procedure Set (K : Key_Enum);
  61       function  Value return Key_Enum;
  62    private
  63       Current : Key_Enum := None;
  64    end Key_PO;
  65
  66
  67    -- Flags for testing purposes
  68    TC_Abortable_Part_Completed : Boolean := False;
  69    TC_Rendezvous_Entered       : Boolean := False;
  70    TC_Delay_Time : constant duration := ImpDef.Switch_To_New_Task;
  71
  72
  73    Count  : Integer := 1234;  -- Global to defeat optimization.
  74
  75
  76    type Card_Number_Type is private;
  77    type Card_PIN_Type    is private;
  78    type ATM_Card_Type    is private;
  79
  80
  81    Transaction_Canceled : exception;
  82
  83
  84    task type ATM_Keyboard_Task is
  85       entry Cancel_Pressed;
  86    end ATM_Keyboard_Task;
  87
  88    procedure Read_Card (Card : in out ATM_Card_Type);
  89
  90    procedure Validate_Card (Card : in ATM_Card_Type);
  91
  92    procedure Perform_Transaction (Card : in ATM_Card_Type);
  93
  94 private
  95
  96    type Card_Number_Type is range   1 .. 9999;
  97    type Card_PIN_Type    is range 100 ..  999;
  98
  99    type ATM_Card_Type is record
 100       Number : Card_Number_Type;
 101       PIN    : Card_PIN_Type;
 102    end record;
 103
 104 end C974011_0;
 105
 106
 107      --==================================================================--
 108
 109
 110 with Report;
 111 package body C974011_0 is
 112
 113    protected body Key_PO is
 114       procedure Set (K : Key_Enum) is
 115       begin
 116          Current := K;
 117       end Set;
 118
 119       function Value return Key_Enum is
 120       begin
 121         return Current;
 122       end Value;
 123    end Key_PO;
 124
 125
 126    procedure Listen_For_Input (Key : out Key_Enum) is
 127    begin
 128       -- Model the situation where the user does not press cancel thus
 129       -- allowing validation to complete
 130
 131       delay TC_Delay_Time;  -- Long enough to force queuing on
 132                             -- Keyboard.Cancel_Pressed.
 133
 134       Key := Key_PO.Value;
 135
 136    end Listen_For_Input;
 137
 138
 139
 140    -- One of these gets created as "Keyboard" for each transaction
 141    --
 142    task body ATM_Keyboard_Task is
 143       Key_Pressed : Key_Enum;
 144    begin
 145       loop
 146                                                            -- Force entry calls
 147          Listen_For_Input (Key_Pressed);                   -- to be queued,
 148
 149          select
 150             when (Key_Pressed = Cancel) =>
 151                accept Cancel_Pressed do
 152                   TC_Rendezvous_Entered := True;
 153                end Cancel_Pressed;
 154
 155                -- User has cancelled the transaction so we exit the
 156                -- loop and allow the task to terminate
 157                exit;
 158          else
 159             delay ImpDef.Switch_To_New_Task;
 160          end select;
 161
 162       end loop;
 163    exception
 164       when others =>
 165           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
 166    end ATM_Keyboard_Task;
 167
 168
 169
 170    procedure Read_Card (Card : in out ATM_Card_Type) is
 171    begin
 172       Card.Number := 9999;
 173       Card.PIN    := 111;
 174    end Read_Card;
 175
 176
 177    procedure Validate_Card (Card : in ATM_Card_Type) is
 178    begin
 179       Count := (Count + 1) mod Integer (Card.PIN);
 180
 181       -- Simulate a validation activity which is longer than the time
 182       -- taken in Listen_For_Input but not inordinately so.
 183       delay TC_Delay_Time * 2;
 184
 185    end Validate_Card;
 186
 187
 188    procedure Perform_Transaction (Card : in ATM_Card_Type) is
 189    begin
 190       if TC_Rendezvous_Entered then
 191          Report.Failed ("Triggering statement completed");
 192       end if;
 193       if Count = 1234 then
 194          -- Initial value is unchanged
 195          Report.Failed ("Abortable part did not execute");
 196       end if;
 197       if not TC_Abortable_Part_Completed then
 198          Report.Failed ("Abortable part did not complete");
 199       end if;
 200    end Perform_Transaction;
 201
 202
 203 end C974011_0;
 204
 205
 206      --==================================================================--
 207
 208
 209 with Report;
 210
 211 with C974011_0;  -- Automated teller machine abstraction.
 212 use  C974011_0;
 213
 214 procedure C974011 is
 215
 216    Card_Data : ATM_Card_Type;
 217
 218 begin  -- Main program.
 219
 220    Report.Test ("C974011", "Asynchronous Select: Trigger is queued on a " &
 221                             "task entry and the abortable part " &
 222                             "completes first");
 223
 224    Read_Card (Card_Data);
 225
 226    declare
 227       -- Create the task for this transaction
 228       Keyboard : C974011_0.ATM_Keyboard_Task;
 229    begin
 230
 231       --                                    --
 232       -- Asynchronous select is tested here --
 233       --                                    --
 234
 235       select
 236
 237          Keyboard.Cancel_Pressed;      -- Entry call is initially queued, so
 238                                        -- abortable part starts.
 239          raise Transaction_Canceled;   -- This would be executed if we
 240                                        -- completed the rendezvous
 241       then abort
 242
 243          Validate_Card (Card_Data);
 244          TC_Abortable_Part_Completed := true;
 245
 246       end select;
 247
 248       Perform_Transaction (Card_Data);
 249
 250
 251       -- Now clear the entry barrier to allow the rendezvous to complete
 252       -- if the triggering call has not been cancelled
 253       Key_PO.Set (Cancel);
 254       --
 255       delay TC_Delay_Time;  -- to allow it all to take place
 256
 257       if TC_Rendezvous_Entered then
 258          Report.Failed ("Triggering Call was not cancelled");
 259       end if;
 260
 261       abort Keyboard;    -- clean up.  (Note: the task will only exit the
 262                          -- loop and terminate if the call hanging on the
 263                          -- entry is executed.)
 264
 265    exception
 266       when Transaction_Canceled =>
 267          Report.Failed ("Triggering alternative sequence of statements " &
 268                            "executed");
 269       when Others =>
 270          Report.Failed ("Unexpected exception in the Main");
 271    end;
 272
 273    Report.Result;
 274
 275 end C974011;