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

   1 -- C974009.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 abortable part of an asynchronous select statement
  28 --      is not started if the triggering statement is a task entry call,
  29 --      the entry call is not queued and the entry call completes by
  30 --      propagating an exception.
  31 --
  32 --      Check that the exception is properly propagated to the asynchronous
  33 --      select statement and thus the sequence of statements of the triggering
  34 --      alternative is not executed after the abortable part is left.
  35 --
  36 --      Check that the exception propagated by the entry call is re-raised
  37 --      immediately following the asynchronous select.
  38 --
  39 -- TEST DESCRIPTION:
  40 --
  41 --      Use a small subset of the base Automated teller machine simulation
  42 --      which is shown in greater detail in other tests of this series.
  43 --      Declare a main procedure containing an asynchronous select with a task
  44 --      entry call as triggering statement.  Force the task to be waiting at
  45 --      the accept statement so that the call is not queued and the rendezvous
  46 --      is executed immediately.  Simulate an unexpected exception in the
  47 --      rendezvous. Use stripped down versions of called procedures to  check
  48 --      the correct path in the test.
  49 --
  50 --
  51 -- CHANGE HISTORY:
  52 --      06 Dec 94   SAIC    ACVC 2.0
  53 --
  54 --!
  55
  56
  57 package C974009_0 is  -- Automated teller machine abstraction.
  58
  59
  60    Propagated_From_Task : exception;
  61    Transaction_Canceled : exception;
  62
  63    type Key_Enum is (None, Cancel, Deposit, Withdraw);
  64
  65    type Card_Number_Type is private;
  66    type Card_PIN_Type    is private;
  67    type ATM_Card_Type    is private;
  68
  69    task type ATM_Keyboard_Task is
  70       entry Cancel_Pressed;
  71    end ATM_Keyboard_Task;
  72
  73
  74    procedure Validate_Card (Card : in ATM_Card_Type);
  75
  76    procedure Perform_Transaction (Card : in ATM_Card_Type);
  77
  78
  79 private
  80
  81    type Card_Number_Type is range   1 .. 9999;
  82    type Card_PIN_Type    is range 100 ..  999;
  83
  84    type ATM_Card_Type is record
  85       Number : Card_Number_Type;
  86       PIN    : Card_PIN_Type;
  87    end record;
  88
  89 end C974009_0;
  90
  91
  92      --==================================================================--
  93
  94
  95 with Report;
  96 package body C974009_0 is
  97
  98
  99
 100    -- One of these gets created as "Keyboard" for each transaction
 101    --
 102    task body ATM_Keyboard_Task is
 103       Key_Pressed : Key_Enum := None;
 104    begin
 105       accept Cancel_Pressed do        -- queued entry call.
 106          null;  --:::: stub, user code for cancel
 107          -- Now simulate an unexpected exception arising in the
 108          -- user code
 109          raise Propagated_From_Task;  -- Propagate an exception.
 110
 111        end Cancel_Pressed;
 112
 113        Report.Failed ("Exception not propagated in ATM_Keyboard_Task");
 114
 115    exception
 116       when Propagated_From_Task =>
 117           null;  -- This is the expected test behavior
 118       when others =>
 119           Report.Failed ("Unexpected Exception in ATM_Keyboard_Task");
 120    end ATM_Keyboard_Task;
 121
 122    procedure Validate_Card (Card : in ATM_Card_Type) is
 123    begin
 124       Report.Failed ("Abortable part was executed");
 125    end Validate_Card;
 126
 127
 128    procedure Perform_Transaction (Card : in ATM_Card_Type) is
 129    begin
 130       Report.Failed ("Exception not re-raised immediately following " &
 131                      "asynchronous select");
 132    end Perform_Transaction;
 133
 134
 135 end C974009_0;
 136
 137
 138      --==================================================================--
 139
 140
 141 with Report;
 142 with ImpDef;
 143
 144 with C974009_0;  -- Automated teller machine abstraction.
 145 use  C974009_0;
 146
 147 procedure C974009 is
 148
 149    Card_Data : ATM_Card_Type;
 150
 151 begin  -- Main program.
 152
 153    Report.Test ("C974009", "Asynchronous Select: Trigger is a call to a " &
 154                            "task entry, is not queued and is completed " &
 155                            "first by an exception");
 156
 157
 158    begin
 159
 160       declare
 161          -- Create the task for this transaction
 162          Keyboard : C974009_0.ATM_Keyboard_Task;
 163       begin
 164
 165          -- Ensure task is waiting a the accept so the call is not queued
 166          -- This is the time required to activate another task and allow it
 167          -- to run to its first accept statement
 168          --
 169          delay ImpDef.Switch_To_New_Task;
 170
 171          --                                    --
 172          -- Asynchronous select is tested here --
 173          --                                    --
 174
 175          select
 176
 177             Keyboard.Cancel_Pressed;
 178
 179             raise Transaction_Canceled;  -- Should not be executed.
 180          then abort
 181             Validate_Card (Card_Data);   -- Keyboard.Cancel_Pressed is accepted
 182                                          -- and propagates an exception before
 183                                          -- this call is executed
 184          end select;
 185
 186          -- The propagated exception is re-raised here.
 187          Perform_Transaction(Card_Data); -- Should not be reached.
 188
 189       exception
 190          when Transaction_Canceled =>
 191             Report.Failed ("Triggering alternative sequence of statements " &
 192                            "executed");
 193          when Propagated_From_Task =>
 194             null;  -- This is the expected test path
 195          when others =>
 196             Report.Failed ("Wrong exception raised");
 197       end;
 198
 199    exception
 200       when others =>
 201             Report.Failed ("Unexpected exception raised");
 202    end;
 203
 204    Report.Result;
 205
 206 end C974009;