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

   1 -- C954022.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 --      In an entry body requeue the call to the same entry.  Check that the
  28 --      items go to the right queue and that they are placed back on the end
  29 --      of the queue
  30 --
  31 -- TEST DESCRIPTION:
  32 --      Simulate part of a message handling application where the messages are
  33 --      composed of several segments.  The sequence of the segments within the
  34 --      message is specified by Seg_Sequence_No.   The segments are handled by
  35 --      different tasks and finally forwarded to an output driver.  The
  36 --      segments can arrive in any order but must be assembled into the proper
  37 --      sequence for final output.  There is a Sequencer task interposed
  38 --      before the Driver.  This takes the segments of the message off the
  39 --      Ordering_Queue and those that are in the right order it sends on to
  40 --      the driver; those that are out of order it places back on the end of
  41 --      the queue.
  42 --
  43 --      The test just simulates the arrival of the segments at the Sequencer.
  44 --      The task generating the segments handshakes with the Sequencer during
  45 --      the  "Await Arrival" phase  ensuring that the three segments of a
  46 --      message arrive in REVERSE order (the End-of-Message segment arrives
  47 --      first and the Header last).  In the first cycle the sequencer pulls
  48 --      segments off the queue and puts them back on the end till it
  49 --      encounters the header.  It checks the sequence of the ones it pulls
  50 --      off in case the segments are being put back on in the wrong part of
  51 --      the queue.  Having cycled once through it no longer verifies the
  52 --      sequence - it just executes the "application" code for the correct
  53 --      order for dispatch to the driver.
  54 --
  55 --      In this simple example no attempt is made to address segments of
  56 --      another message arriving or any other error conditions (such as
  57 --      missing segments, timing etc.)
  58 --
  59 --
  60 -- CHANGE HISTORY:
  61 --      06 Dec 94   SAIC    ACVC 2.0
  62 --      07 Nov 95   SAIC    ACVC 2.0.1
  63 --
  64 --!
  65
  66 with Report;
  67 with ImpDef;
  68
  69 procedure C954022 is
  70
  71    -- These global Booleans are set when failure conditions inside Protected
  72    -- objects are encountered.  Report.Failed cannot be called within
  73    -- the object or a Bounded Error would occur
  74    --
  75    TC_Failed_1 : Boolean := false;
  76    TC_Failed_2 : Boolean := false;
  77    TC_Failed_3 : Boolean := false;
  78
  79 begin
  80
  81
  82    Report.Test ("C954022", "Check Requeue to the same Protected Entry");
  83
  84    declare  -- encapsulate the test
  85
  86       type Segment_Sequence is range 1..8;
  87       Header : constant Segment_Sequence := Segment_Sequence'first;
  88
  89       type Message_Segment is record
  90          ID              : integer;            -- Message ID
  91          Seg_Sequence_No : Segment_Sequence;   -- Within the message
  92          Segs_In_Message : integer;            -- Total segs this message
  93          EOM             : Boolean := false;   -- true for final msg segment
  94          Alpha           : string (1..128);
  95       end record;
  96       type acc_Message_Segment is access Message_Segment;
  97
  98       task TC_Simulate_Arrival;
  99
 100       task type Carrier_Task is
 101          entry Input ( Segment : acc_Message_Segment );
 102       end Carrier_Task;
 103       type acc_Carrier_Task is access Carrier_Task;
 104
 105       protected Sequencer is
 106          function  TC_Arrivals return integer;
 107          entry Input          ( Segment : acc_Message_Segment );
 108          entry Ordering_Queue ( Segment : acc_Message_Segment );
 109       private
 110          Number_of_Segments_Arrived  : integer := 0;
 111          Number_of_Segments_Expected : integer := 0;
 112          Next_Needed : Segment_Sequence := Header;
 113          All_Segments_Arrived : Boolean := false;
 114          Seen_EOM             : Boolean := false;
 115
 116          TC_First_Cycle       : Boolean := true;
 117          TC_Expected_Sequence : Segment_Sequence := Header+2;
 118
 119       end Sequencer;
 120
 121
 122       task Output_Driver is
 123          entry Input ( Segment : acc_Message_Segment );
 124       end Output_Driver;
 125
 126
 127       -- Simulate the arrival of three message segments in REVERSE order
 128       --
 129       task body TC_Simulate_Arrival is
 130          begin
 131             for i in 1..3 loop
 132                declare
 133                   -- Create a task for the next message segment
 134                   Next_Segment_Task : acc_Carrier_Task := new Carrier_Task;
 135                   -- Create a record for the next segment
 136                   Next_Segment : acc_Message_Segment := new Message_Segment;
 137                begin
 138                   if i = 1 then
 139                      -- Build the EOM segment as the first to "send"
 140                      Next_Segment.Seg_Sequence_No := Header + 2;
 141                      Next_Segment.Segs_In_Message := 3;
 142                      Next_Segment.EOM := true;
 143                   elsif i = 2 then
 144                      -- Wait for the first segment to arrive at the Sequencer
 145                      -- before "sending" the second
 146                      while Sequencer.TC_Arrivals < 1 loop
 147                         delay ImpDef.Minimum_Task_Switch;
 148                      end loop;
 149                      -- Build the segment
 150                      Next_Segment.Seg_Sequence_No := Header +1;
 151                   else
 152                      -- Wait for the second segment to arrive at the Sequencer
 153                      -- before "sending" the third
 154                      while Sequencer.TC_Arrivals < 2 loop
 155                         delay ImpDef.Minimum_Task_Switch;
 156                      end loop;
 157                      -- Build the segment. The last segment (in order) to
 158                      -- arrive will be the "header" segment
 159                      Next_Segment.Seg_Sequence_No := Header;
 160                   end if;
 161                   -- pass the record to its carrier
 162                   Next_Segment_Task.Input ( Next_Segment );
 163                end;
 164             end loop;
 165
 166
 167       exception
 168          when others =>
 169               Report.Failed ("Unexpected Exception in TC_Simulate_Arrival");
 170       end TC_Simulate_Arrival;
 171
 172
 173       -- One of these is generated for each message segment and the flow
 174       -- of the segments through the system is controlled by the calls the
 175       -- task makes and the requeues of those calls
 176       --
 177       task body Carrier_Task is
 178          This_Segment : acc_Message_Segment := new Message_Segment;
 179       begin
 180          accept Input ( Segment : acc_Message_Segment ) do
 181             This_Segment.all := Segment.all;
 182          end Input;
 183          null; --:: stub.  Pass the segment around the application as needed
 184
 185          -- Now output the segment to the Output_Driver.  First we have to
 186          -- go through the Sequencer.
 187          Sequencer.Input ( This_Segment );
 188       exception
 189          when others =>
 190               Report.Failed ("Unexpected Exception in Carrier_Task");
 191       end Carrier_Task;
 192
 193       -- Store segments on the Ordering_Queue then deliver them in the correct
 194       -- sequence to the Output_Driver.
 195       --
 196       protected body Sequencer is
 197
 198          function  TC_Arrivals return integer is
 199          begin
 200             return Number_of_Segments_Arrived;
 201          end TC_Arrivals;
 202
 203
 204          -- Segments arriving at the Input queue are counted and checked
 205          -- against the total number of segments for the message.  They
 206          -- are requeued onto the ordering queue where they are held until
 207          -- all the segments have arrived.
 208          entry Input ( Segment : acc_Message_Segment ) when true is
 209          begin
 210             -- check for EOM, if so get the number of segments in the message
 211             -- Note: in this portion of code no attempt is made to address
 212             -- reset for new message , end conditions, missing segments,
 213             -- segments of a different message etc.
 214             Number_of_Segments_Arrived := Number_of_Segments_Arrived + 1;
 215             if Segment.EOM then
 216                Number_of_Segments_Expected := Segment.Segs_In_Message;
 217                Seen_EOM := true;
 218             end if;
 219
 220             if Seen_EOM then
 221                if Number_of_Segments_Arrived = Number_of_Segments_Expected then
 222                   -- This is the last segment for this message
 223                   All_Segments_Arrived := true;    -- clear the barrier
 224                end if;
 225             end if;
 226
 227             requeue Ordering_Queue;
 228
 229             -- At this exit point the entry queue barriers are evaluated
 230
 231          end Input;
 232
 233
 234          entry Ordering_Queue ( Segment : acc_Message_Segment )
 235                                                   when All_Segments_Arrived is
 236             begin
 237
 238             --=====================================================
 239             -- This part is all Test_Control code
 240
 241             if TC_First_Cycle then
 242                -- Check the order of the original three
 243                if Segment.Seg_Sequence_No /= TC_Expected_Sequence then
 244                   -- The segments are not being pulled off in the
 245                   -- expected sequence.  This could occur if the
 246                   -- requeue is not putting them back on the end.
 247                   TC_Failed_3 := true;
 248                end if; -- sequence check
 249                -- Decrement the expected sequence
 250                if TC_Expected_Sequence /= Header then
 251                   TC_Expected_Sequence := TC_Expected_Sequence - 1;
 252                else
 253                   TC_First_Cycle := false; -- This is the Header - the
 254                                            -- first two segments are
 255                                            -- back on the queue
 256                end if; -- decrementing
 257             end if; -- first cycle
 258             --=====================================================
 259
 260             -- And this is the Application code
 261             if Segment.Seg_Sequence_No = Next_Needed then
 262                if Segment.EOM then
 263                   Next_Needed := Header;  -- reset for next message
 264                   -- :: other resets not shown
 265                else
 266                   Next_Needed := Next_Needed + 1;
 267                end if;
 268                requeue Output_Driver.Input  with abort;
 269                -- set to Report Failed - Requeue did not complete entry body
 270                TC_Failed_1 := true;
 271             else
 272                -- Not the next needed - put it back on the queue
 273                --    NOTE: here we are requeueing to the same entry
 274                requeue Sequencer.Ordering_Queue;
 275                -- set to Report Failed - Requeue did not complete entry body
 276                TC_Failed_2 := true;
 277             end if;
 278          end Ordering_Queue;
 279       end Sequencer;
 280
 281
 282       task body Output_Driver is
 283          This_Segment : acc_Message_Segment := new Message_Segment;
 284
 285          TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first;
 286          TC_Segment_Total : integer := 0;
 287          TC_Expected_Total : integer := 3;
 288       begin
 289          loop
 290             -- Note: normally we would expect this Accept to be in a select
 291             -- with terminate.  For the test we exit the loop on completion
 292             -- to give better control
 293             accept Input ( Segment : acc_Message_Segment ) do
 294                This_Segment.all := Segment.all;
 295             end Input;
 296
 297             null;  --::: stub - output the next segment of the message
 298
 299             -- The following is all test control code
 300             --
 301             if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then
 302                Report.Failed ("Output_Driver: Segment out of sequence");
 303             end if;
 304             TC_Expected_Sequence := TC_Expected_Sequence + 1;
 305
 306             -- Now count the number of segments
 307             TC_Segment_Total := TC_Segment_Total + 1;
 308
 309             -- Check the number and exit loop when complete
 310             -- There must be exactly TC_Expected_Total in number and
 311             --    the last one must be EOM
 312             --    (test will hang if < TC_Expected_Total arrive
 313             --    without EOM)
 314             if This_Segment.EOM then
 315                -- This is the last segment.
 316                if TC_Segment_Total /= TC_Expected_Total then
 317                   Report.Failed ("EOM and wrong number of segments");
 318                end if;
 319                exit;   -- the loop and terminate the task
 320             elsif TC_Segment_Total = TC_Expected_Total then
 321                Report.Failed ("No EOM found");
 322                exit;
 323             end if;
 324          end loop;
 325       exception
 326          when others =>
 327               Report.Failed ("Unexpected Exception in Output_Driver");
 328       end Output_Driver;
 329
 330
 331    begin
 332
 333       null;
 334
 335    end; -- encapsulation
 336
 337    if TC_Failed_1 then
 338       Report.Failed ("Requeue did not complete entry body - 1");
 339    end if;
 340
 341    if TC_Failed_2 then
 342       Report.Failed ("Requeue did not complete entry body - 2");
 343    end if;
 344
 345    if TC_Failed_3 then
 346       Report.Failed ("Sequencer: Segment out of sequence");
 347    end if;
 348
 349    Report.Result;
 350
 351 end C954022;