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

   1 -- C974006.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 executed if the triggering
  29 --      statement is a protected entry call, and the entry is accepted
  30 --      immediately. Check that the corresponding entry body is executed
  31 --      before the sequence of statements of the triggering alternative.
  32 --      Check that the abortable part is not executed.
  33 --
  34 -- TEST DESCRIPTION:
  35 --      Declare a main procedure containing an asynchronous select with a
  36 --      protected entry call as triggering statement. Declare a protected
  37 --      procedure which sets the protected entry's barrier true. Force the
  38 --      entry call to be accepted immediately by calling this protected
  39 --      procedure prior to the asynchronous select. Since the entry call
  40 --      is accepted immediately, the abortable part should never start. When
  41 --      entry call completes, the sequence of statements of the triggering
  42 --      alternative should execute.
  43 --
  44 --
  45 -- CHANGE HISTORY:
  46 --      06 Dec 94   SAIC    ACVC 2.0
  47 --
  48 --!
  49
  50
  51 package C974006_0 is  -- Automated teller machine abstraction.
  52
  53
  54    -- Flag for testing purposes:
  55
  56    Entry_Body_Executed : Boolean := False;
  57
  58
  59    type Key_Enum is (None, Cancel, Deposit, Withdraw);
  60
  61    type Card_Number_Type is private;
  62    type Card_PIN_Type    is private;
  63    type ATM_Card_Type    is private;
  64
  65
  66    Transaction_Canceled : exception;
  67
  68
  69    protected type ATM_Keyboard_Protected is
  70       entry Cancel_Pressed;
  71       procedure Read_Key;
  72    private
  73       Last_Key_Pressed : Key_Enum := None;
  74    end ATM_Keyboard_Protected;
  75
  76
  77    procedure Read_Card (Card : in out ATM_Card_Type);
  78
  79    procedure Validate_Card (Card : in ATM_Card_Type);
  80
  81    procedure Perform_Transaction (Card : in ATM_Card_Type);
  82
  83 private
  84
  85    type Card_Number_Type is range   1 .. 9999;
  86    type Card_PIN_Type    is range 100 ..  999;
  87
  88    type ATM_Card_Type is record
  89       Number : Card_Number_Type;
  90       PIN    : Card_PIN_Type;
  91    end record;
  92
  93 end C974006_0;
  94
  95
  96      --==================================================================--
  97
  98
  99 with Report;
 100 package body C974006_0 is
 101
 102
 103    protected body ATM_Keyboard_Protected is
 104
 105       entry Cancel_Pressed when (Last_Key_Pressed = Cancel) is
 106       begin
 107          Entry_Body_Executed := True;
 108       end Cancel_Pressed;
 109
 110       procedure Read_Key is
 111       begin
 112          -- Simulate a procedure which processes user keyboard input, and
 113          -- which is called by some interrupt handler.
 114          Last_Key_Pressed := Cancel;
 115       end Read_Key;
 116
 117    end ATM_Keyboard_Protected;
 118
 119
 120    procedure Read_Card (Card : in out ATM_Card_Type) is
 121    begin
 122       Card.Number := 9999;
 123       Card.PIN    := 111;
 124    end Read_Card;
 125
 126
 127    procedure Validate_Card (Card : in ATM_Card_Type) is
 128    begin
 129       Report.Failed ("Abortable part executed");
 130    end Validate_Card;
 131
 132
 133    procedure Perform_Transaction (Card : in ATM_Card_Type) is
 134    begin
 135       Report.Failed ("Triggering alternative sequence of statements " &
 136                       "not fully executed");
 137    end Perform_Transaction;
 138
 139
 140 end C974006_0;
 141
 142
 143      --==================================================================--
 144
 145
 146 with Report;
 147
 148 with C974006_0;  -- Automated teller machine abstraction.
 149 use  C974006_0;
 150
 151 procedure C974006 is
 152
 153    Card_Data : ATM_Card_Type;
 154
 155 begin
 156
 157    Report.Test ("C974006", "ATC: trigger is protected entry call" &
 158                               " and completes first");
 159
 160    Read_Card (Card_Data);
 161
 162    declare
 163       Keyboard : C974006_0.ATM_Keyboard_Protected;
 164    begin
 165
 166       -- Simulate the situation where the user hits cancel before the
 167       -- validation process can start:
 168       Keyboard.Read_Key;                 -- Force Keyboard.Cancel_Pressed to
 169                                          -- be accepted immediately.
 170
 171       --                                    --
 172       -- Asynchronous select is tested here --
 173       --                                    --
 174
 175       select
 176          Keyboard.Cancel_Pressed;        -- Entry call is accepted immediately,
 177                                          -- so abortable part does NOT start.
 178
 179          if not Entry_Body_Executed then -- Executes after entry completes.
 180             Report.Failed ("Triggering alternative sequence of statements " &
 181                            "executed before triggering statement complete");
 182          end if;
 183
 184          raise Transaction_Canceled;     -- Control passes to exception
 185                                          -- handler.
 186       then abort
 187          Validate_Card (Card_Data);      -- Should not be executed.
 188       end select;
 189       Perform_Transaction (Card_Data);   -- Should not be reached.
 190    exception
 191       when Transaction_Canceled =>
 192          null;
 193    end;
 194
 195    Report.Result;
 196
 197 end C974006;