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

   1 -- C974012.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 is
  28 --      aborted if it does not complete before the triggering statement
  29 --      completes, where the triggering statement is a call on a protected
  30 --      entry which is queued.
  31 --
  32 -- TEST DESCRIPTION:
  33 --      A fraction of in-line code is simulated.  A voltage deficiency causes
  34 --      the routine to seek an alternate best-cost route on an electrical grid
  35 --      system.
  36 --
  37 --      An asynchronous select is used with the triggering alternative being a
  38 --      call to a protected entry with a barrier.  The abortable part is a
  39 --      routine simulating the lengthy alternate path negotiation.  The entry
  40 --      barrier would be cleared if the voltage deficiency is rectified before
  41 --      the alternate can be found thus nullifying the need for the alternate.
  42 --
  43 --      The test simulates a return to normal in the middle of the
  44 --      negotiation.  The barrier is cleared, the triggering alternative
  45 --      completes first and the abortable part should be aborted.
  46 --
  47 --
  48 -- CHANGE HISTORY:
  49 --      06 Dec 94   SAIC    ACVC 2.0
  50 --
  51 --!
  52
  53
  54 with Report;
  55 with ImpDef;
  56
  57 procedure C974012 is
  58
  59    subtype Grid_Path is string(1..21);
  60    subtype Deficiency is integer range 100..1_000;   -- in MWh
  61
  62    New_Path         : Grid_Path;
  63    Dummy_Deficiency : Deficiency := 520;
  64    Path_Available   : Boolean    := false;
  65
  66    TC_Terminate_Negotiation_Executed  : Boolean := false;
  67    TC_Trigger_Completed               : Boolean := false;
  68    TC_Negotiation_Completed           : Boolean := false;
  69
  70    protected Local_Deficit is
  71       procedure Set_Good_Voltage;
  72       procedure Bad_Voltage;
  73       entry Terminate_Negotiation;
  74    private
  75       Good_Voltage   : Boolean := false;   -- barrier
  76    end Local_Deficit;
  77
  78    protected body Local_Deficit is
  79
  80       procedure Set_Good_Voltage is
  81       begin
  82          Good_Voltage := true;
  83       end Set_Good_Voltage;
  84
  85       procedure Bad_Voltage is
  86       begin
  87          Good_Voltage := false;
  88       end Bad_Voltage;
  89
  90       -- Trigger is queued on this entry with barrier condition
  91       entry Terminate_Negotiation when Good_Voltage is
  92       begin
  93          -- complete the triggering call thus terminating grid_path
  94          -- negotiation.
  95          null; --::: stub - signal main board
  96          TC_Terminate_Negotiation_Executed := true;   -- show path traversal
  97       end Terminate_Negotiation;
  98
  99    end Local_Deficit;
 100
 101
 102    -- Routine to find the most cost effective grid path for this
 103    -- particular deficiency at this particular time
 104    --
 105    procedure Path_Negotiation (Requirement : in  Deficiency;
 106                                Best_Path   : out Grid_Path  ) is
 107
 108       Dummy_Path : Grid_Path := "NYC.425_NY.227_NH.132";
 109       Match : Deficiency := Report.Ident_Int (Requirement);
 110
 111    begin
 112       --
 113       null; --::: stub
 114       --
 115       -- Simulate a lengthy path negotiation
 116       for i in 1..5 loop
 117          delay ImpDef.Minimum_Task_Switch;
 118          -- Part of the way through the negotiation simulate some external
 119          -- event returning the voltage to acceptable level
 120          if i = 3 then
 121             Local_Deficit.Set_Good_Voltage;   -- clear the barrier
 122          end if;
 123       end loop;
 124
 125       Best_Path := Dummy_Path;
 126       TC_Negotiation_Completed := true;
 127
 128    end Path_Negotiation;
 129
 130
 131
 132 begin
 133
 134    Report.Test ("C974012", "Asynchronous Select: Trigger is queued on a " &
 135                            "protected entry and completes before the " &
 136                            "abortable part");
 137
 138    -- :::::::::   Fragment of code
 139
 140    Local_Deficit.Bad_Voltage;      -- Set barrier condition
 141
 142    -- For the given voltage deficiency start negotiating the best grid
 143    -- path.  If voltage returns to acceptable level cancel the negotiation
 144    --
 145    select
 146       -- Prepare to terminate the Path_Negotiation if voltage improves
 147       Local_Deficit.Terminate_Negotiation;
 148       TC_Trigger_Completed := true;
 149    then abort
 150       Path_Negotiation (Dummy_Deficiency, New_Path) ;
 151       Path_Available := true;
 152    end select;
 153    -- :::::::::
 154
 155    if not TC_Terminate_Negotiation_Executed or else not
 156                                                TC_Trigger_Completed then
 157       Report.Failed ("Unexpected test path taken");
 158    end if;
 159
 160    if Path_Available or else TC_Negotiation_Completed then
 161       Report.Failed ("Abortable part was not aborted");
 162    end if;
 163    Report.Result;
 164
 165 end C974012;