From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/c9/c954022.a | 351 +++++++++++++++++++++++++++++ 1 file changed, 351 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/c9/c954022.a (limited to 'gcc/testsuite/ada/acats/tests/c9/c954022.a') diff --git a/gcc/testsuite/ada/acats/tests/c9/c954022.a b/gcc/testsuite/ada/acats/tests/c9/c954022.a new file mode 100644 index 000000000..5ebff8dcb --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c9/c954022.a @@ -0,0 +1,351 @@ +-- C954022.A +-- +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, +-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained +-- unlimited rights in the software and documentation contained herein. +-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making +-- this public release, the Government intends to confer upon all +-- recipients unlimited rights equal to those held by the Government. +-- These rights include rights to use, duplicate, release or disclose the +-- released technical data and computer software in whole or in part, in +-- any manner and for any purpose whatsoever, and to have or permit others +-- to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- +-- OBJECTIVE: +-- In an entry body requeue the call to the same entry. Check that the +-- items go to the right queue and that they are placed back on the end +-- of the queue +-- +-- TEST DESCRIPTION: +-- Simulate part of a message handling application where the messages are +-- composed of several segments. The sequence of the segments within the +-- message is specified by Seg_Sequence_No. The segments are handled by +-- different tasks and finally forwarded to an output driver. The +-- segments can arrive in any order but must be assembled into the proper +-- sequence for final output. There is a Sequencer task interposed +-- before the Driver. This takes the segments of the message off the +-- Ordering_Queue and those that are in the right order it sends on to +-- the driver; those that are out of order it places back on the end of +-- the queue. +-- +-- The test just simulates the arrival of the segments at the Sequencer. +-- The task generating the segments handshakes with the Sequencer during +-- the "Await Arrival" phase ensuring that the three segments of a +-- message arrive in REVERSE order (the End-of-Message segment arrives +-- first and the Header last). In the first cycle the sequencer pulls +-- segments off the queue and puts them back on the end till it +-- encounters the header. It checks the sequence of the ones it pulls +-- off in case the segments are being put back on in the wrong part of +-- the queue. Having cycled once through it no longer verifies the +-- sequence - it just executes the "application" code for the correct +-- order for dispatch to the driver. +-- +-- In this simple example no attempt is made to address segments of +-- another message arriving or any other error conditions (such as +-- missing segments, timing etc.) +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- 07 Nov 95 SAIC ACVC 2.0.1 +-- +--! + +with Report; +with ImpDef; + +procedure C954022 is + + -- These global Booleans are set when failure conditions inside Protected + -- objects are encountered. Report.Failed cannot be called within + -- the object or a Bounded Error would occur + -- + TC_Failed_1 : Boolean := false; + TC_Failed_2 : Boolean := false; + TC_Failed_3 : Boolean := false; + +begin + + + Report.Test ("C954022", "Check Requeue to the same Protected Entry"); + + declare -- encapsulate the test + + type Segment_Sequence is range 1..8; + Header : constant Segment_Sequence := Segment_Sequence'first; + + type Message_Segment is record + ID : integer; -- Message ID + Seg_Sequence_No : Segment_Sequence; -- Within the message + Segs_In_Message : integer; -- Total segs this message + EOM : Boolean := false; -- true for final msg segment + Alpha : string (1..128); + end record; + type acc_Message_Segment is access Message_Segment; + + task TC_Simulate_Arrival; + + task type Carrier_Task is + entry Input ( Segment : acc_Message_Segment ); + end Carrier_Task; + type acc_Carrier_Task is access Carrier_Task; + + protected Sequencer is + function TC_Arrivals return integer; + entry Input ( Segment : acc_Message_Segment ); + entry Ordering_Queue ( Segment : acc_Message_Segment ); + private + Number_of_Segments_Arrived : integer := 0; + Number_of_Segments_Expected : integer := 0; + Next_Needed : Segment_Sequence := Header; + All_Segments_Arrived : Boolean := false; + Seen_EOM : Boolean := false; + + TC_First_Cycle : Boolean := true; + TC_Expected_Sequence : Segment_Sequence := Header+2; + + end Sequencer; + + + task Output_Driver is + entry Input ( Segment : acc_Message_Segment ); + end Output_Driver; + + + -- Simulate the arrival of three message segments in REVERSE order + -- + task body TC_Simulate_Arrival is + begin + for i in 1..3 loop + declare + -- Create a task for the next message segment + Next_Segment_Task : acc_Carrier_Task := new Carrier_Task; + -- Create a record for the next segment + Next_Segment : acc_Message_Segment := new Message_Segment; + begin + if i = 1 then + -- Build the EOM segment as the first to "send" + Next_Segment.Seg_Sequence_No := Header + 2; + Next_Segment.Segs_In_Message := 3; + Next_Segment.EOM := true; + elsif i = 2 then + -- Wait for the first segment to arrive at the Sequencer + -- before "sending" the second + while Sequencer.TC_Arrivals < 1 loop + delay ImpDef.Minimum_Task_Switch; + end loop; + -- Build the segment + Next_Segment.Seg_Sequence_No := Header +1; + else + -- Wait for the second segment to arrive at the Sequencer + -- before "sending" the third + while Sequencer.TC_Arrivals < 2 loop + delay ImpDef.Minimum_Task_Switch; + end loop; + -- Build the segment. The last segment (in order) to + -- arrive will be the "header" segment + Next_Segment.Seg_Sequence_No := Header; + end if; + -- pass the record to its carrier + Next_Segment_Task.Input ( Next_Segment ); + end; + end loop; + + + exception + when others => + Report.Failed ("Unexpected Exception in TC_Simulate_Arrival"); + end TC_Simulate_Arrival; + + + -- One of these is generated for each message segment and the flow + -- of the segments through the system is controlled by the calls the + -- task makes and the requeues of those calls + -- + task body Carrier_Task is + This_Segment : acc_Message_Segment := new Message_Segment; + begin + accept Input ( Segment : acc_Message_Segment ) do + This_Segment.all := Segment.all; + end Input; + null; --:: stub. Pass the segment around the application as needed + + -- Now output the segment to the Output_Driver. First we have to + -- go through the Sequencer. + Sequencer.Input ( This_Segment ); + exception + when others => + Report.Failed ("Unexpected Exception in Carrier_Task"); + end Carrier_Task; + + -- Store segments on the Ordering_Queue then deliver them in the correct + -- sequence to the Output_Driver. + -- + protected body Sequencer is + + function TC_Arrivals return integer is + begin + return Number_of_Segments_Arrived; + end TC_Arrivals; + + + -- Segments arriving at the Input queue are counted and checked + -- against the total number of segments for the message. They + -- are requeued onto the ordering queue where they are held until + -- all the segments have arrived. + entry Input ( Segment : acc_Message_Segment ) when true is + begin + -- check for EOM, if so get the number of segments in the message + -- Note: in this portion of code no attempt is made to address + -- reset for new message , end conditions, missing segments, + -- segments of a different message etc. + Number_of_Segments_Arrived := Number_of_Segments_Arrived + 1; + if Segment.EOM then + Number_of_Segments_Expected := Segment.Segs_In_Message; + Seen_EOM := true; + end if; + + if Seen_EOM then + if Number_of_Segments_Arrived = Number_of_Segments_Expected then + -- This is the last segment for this message + All_Segments_Arrived := true; -- clear the barrier + end if; + end if; + + requeue Ordering_Queue; + + -- At this exit point the entry queue barriers are evaluated + + end Input; + + + entry Ordering_Queue ( Segment : acc_Message_Segment ) + when All_Segments_Arrived is + begin + + --===================================================== + -- This part is all Test_Control code + + if TC_First_Cycle then + -- Check the order of the original three + if Segment.Seg_Sequence_No /= TC_Expected_Sequence then + -- The segments are not being pulled off in the + -- expected sequence. This could occur if the + -- requeue is not putting them back on the end. + TC_Failed_3 := true; + end if; -- sequence check + -- Decrement the expected sequence + if TC_Expected_Sequence /= Header then + TC_Expected_Sequence := TC_Expected_Sequence - 1; + else + TC_First_Cycle := false; -- This is the Header - the + -- first two segments are + -- back on the queue + end if; -- decrementing + end if; -- first cycle + --===================================================== + + -- And this is the Application code + if Segment.Seg_Sequence_No = Next_Needed then + if Segment.EOM then + Next_Needed := Header; -- reset for next message + -- :: other resets not shown + else + Next_Needed := Next_Needed + 1; + end if; + requeue Output_Driver.Input with abort; + -- set to Report Failed - Requeue did not complete entry body + TC_Failed_1 := true; + else + -- Not the next needed - put it back on the queue + -- NOTE: here we are requeueing to the same entry + requeue Sequencer.Ordering_Queue; + -- set to Report Failed - Requeue did not complete entry body + TC_Failed_2 := true; + end if; + end Ordering_Queue; + end Sequencer; + + + task body Output_Driver is + This_Segment : acc_Message_Segment := new Message_Segment; + + TC_Expected_Sequence : Segment_Sequence := Segment_Sequence'first; + TC_Segment_Total : integer := 0; + TC_Expected_Total : integer := 3; + begin + loop + -- Note: normally we would expect this Accept to be in a select + -- with terminate. For the test we exit the loop on completion + -- to give better control + accept Input ( Segment : acc_Message_Segment ) do + This_Segment.all := Segment.all; + end Input; + + null; --::: stub - output the next segment of the message + + -- The following is all test control code + -- + if This_Segment.Seg_Sequence_No /= TC_Expected_Sequence then + Report.Failed ("Output_Driver: Segment out of sequence"); + end if; + TC_Expected_Sequence := TC_Expected_Sequence + 1; + + -- Now count the number of segments + TC_Segment_Total := TC_Segment_Total + 1; + + -- Check the number and exit loop when complete + -- There must be exactly TC_Expected_Total in number and + -- the last one must be EOM + -- (test will hang if < TC_Expected_Total arrive + -- without EOM) + if This_Segment.EOM then + -- This is the last segment. + if TC_Segment_Total /= TC_Expected_Total then + Report.Failed ("EOM and wrong number of segments"); + end if; + exit; -- the loop and terminate the task + elsif TC_Segment_Total = TC_Expected_Total then + Report.Failed ("No EOM found"); + exit; + end if; + end loop; + exception + when others => + Report.Failed ("Unexpected Exception in Output_Driver"); + end Output_Driver; + + + begin + + null; + + end; -- encapsulation + + if TC_Failed_1 then + Report.Failed ("Requeue did not complete entry body - 1"); + end if; + + if TC_Failed_2 then + Report.Failed ("Requeue did not complete entry body - 2"); + end if; + + if TC_Failed_3 then + Report.Failed ("Sequencer: Segment out of sequence"); + end if; + + Report.Result; + +end C954022; -- cgit v1.2.3