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

   1 -- C980002.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 aborts are deferred during protected actions.
  28 --
  29 -- TEST DESCRIPTION:
  30 --      This test uses an asynchronous transfer of control to attempt
  31 --      to abort a protected operation.  The protected operation
  32 --      includes several requeues to check that the requeue does not
  33 --      allow the abort to occur.
  34 --
  35 --
  36 -- CHANGE HISTORY:
  37 --      30 OCT 95   SAIC    ACVC 2.1
  38 --
  39 --!
  40
  41 with Report;
  42 procedure C980002 is
  43
  44   Max_Checkpoints : constant := 7;
  45   type Checkpoint_ID is range 1..Max_Checkpoints;
  46   type Points_Array is array (Checkpoint_ID) of Boolean;
  47 begin
  48   Report.Test ("C980002",
  49                "Check that aborts are deferred during a protected action" &
  50                " including requeues");
  51
  52   declare -- test encapsulation
  53
  54     protected Checkpoint is
  55        procedure Got_Here (Id : Checkpoint_ID);
  56        function Results return Points_Array;
  57     private
  58        Reached_Points : Points_Array := (others => False);
  59     end Checkpoint;
  60
  61     protected body Checkpoint is
  62        procedure Got_Here (Id : Checkpoint_ID) is
  63        begin
  64           Reached_Points (Id) := True;
  65        end Got_Here;
  66
  67        function Results return Points_Array is
  68        begin
  69           return Reached_Points;
  70        end Results;
  71     end Checkpoint;
  72
  73
  74     protected Start_Here is
  75        entry AST_Waits_Here;
  76        entry Start_PO;
  77     private
  78        Open : Boolean := False;
  79        entry First_Stop;
  80     end Start_Here;
  81
  82     protected Middle_PO is
  83        entry Stop_1;
  84        entry Stop_2;
  85     end Middle_PO;
  86
  87     protected Final_PO is
  88        entry Final_Stop;
  89     end Final_PO;
  90
  91
  92     protected body Start_Here is
  93        entry AST_Waits_Here when Open is
  94        begin
  95           null;
  96        end AST_Waits_Here;
  97
  98        entry Start_PO when True is
  99        begin
 100           Open := True;
 101           Checkpoint.Got_Here (1);
 102           requeue First_Stop;
 103        end Start_PO;
 104
 105        -- make sure the AST has been accepted before continuing
 106        entry First_Stop when AST_Waits_Here'Count = 0 is
 107        begin
 108           Checkpoint.Got_Here (2);
 109           requeue Middle_PO.Stop_1;
 110        end First_Stop;
 111     end Start_Here;
 112
 113     protected body Middle_PO is
 114        entry Stop_1 when True is
 115        begin
 116           Checkpoint.Got_Here (3);
 117           requeue Stop_2;
 118        end Stop_1;
 119
 120        entry Stop_2 when True is
 121        begin
 122           Checkpoint.Got_Here (4);
 123           requeue Final_PO.Final_Stop;
 124        end Stop_2;
 125     end Middle_PO;
 126
 127     protected body Final_PO is
 128        entry Final_Stop when True is
 129        begin
 130           Checkpoint.Got_Here (5);
 131        end Final_Stop;
 132     end Final_PO;
 133
 134
 135   begin   -- test encapsulation
 136     select
 137        Start_Here.AST_Waits_Here;
 138        Checkpoint.Got_Here (6);
 139     then abort
 140        Start_Here.Start_PO;
 141        delay 0.0;  -- abort completion point
 142        Checkpoint.Got_Here (7);
 143     end select;
 144
 145     Check_The_Results: declare
 146        Chk : constant Points_Array := Checkpoint.Results;
 147        Expected : constant Points_Array :=  (1..6 => True,
 148                                              7    => False);
 149     begin
 150        for I in Checkpoint_ID loop
 151           if Chk (I) /= Expected (I) then
 152              Report.Failed ("checkpoint error" &
 153                             Checkpoint_ID'Image (I) &
 154                             " actual is " &
 155                             Boolean'Image (Chk(I)));
 156           end if;
 157        end loop;
 158     end Check_The_Results;
 159   exception
 160     when others =>
 161        Report.Failed ("unexpected exception");
 162   end;    -- test encapsulation
 163
 164   Report.Result;
 165 end C980002;