diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a | 206 |
1 files changed, 206 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a new file mode 100644 index 000000000..f394aab66 --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c960004.a @@ -0,0 +1,206 @@ +-- C960004.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: +-- With the triggering statement being a delay and with the Asynchronous +-- Select statement being in a tasking situation complete the abortable +-- part before the delay expires. Check that the delay is cancelled +-- and that the optional statements in the triggering part are not +-- executed. +-- +-- TEST DESCRIPTION: +-- Simulate the creation of a carrier task to control the output of +-- a message via a line driver. If the message sending process is +-- not complete (the completion of the rendezvous) within a +-- specified time the carrier task is designed to take corrective action. +-- Use an asynchronous select to control the timing; arrange that +-- the abortable part (the rendezvous) completes almost immediately. +-- Check that the optional statements are not executed and that the +-- test completes well before the time of the trigger delay request thus +-- showing that it has been cancelled. +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + + +with Report; +with Ada.Calendar; + +procedure C960004 is + + function "-" (Left, Right : Ada.Calendar.Time) + return Duration renames Ada.Calendar."-"; + TC_Start_Time : Ada.Calendar.Time := Ada.Calendar.Clock; + TC_Elapsed_Time : duration; + + -- Note: a properly executing test will complete immediately. + Allowable_ACK_Time : duration := 600.0; + +begin + + Report.Test ("C960004", "ATC: When abortable part completes before " & + "a triggering delay, check that the delay " & + "is cancelled & optional statements " & + "are not performed. Tasking situation"); + + declare -- To get the Report.Result after all has completed + + type Sequence_Number is range 1..1_999_999; -- Message Number + subtype S_length_subtype is integer range 1..80; + + type Message_Type (Max_String : S_length_subtype := 1) is + record + Message_Number : Sequence_Number; + Alpha : string(1..Max_String); + end record; + + -- TC: Dummy message for the test + Dummy_Alpha : constant string := "This could be printed"; + Message_to_Send : Message_Type (Max_string => Dummy_Alpha'length); + + + -- This is the carrier task. One of these is created for each + -- message that requires ACK + -- + task type Require_ACK_task is + entry Message_In (Message_to_Send: Message_Type); + end Require_ACK_task; + type acc_Require_ACK_task is access Require_ACK_task; + + + --::::::::::::::::::::::::::::::::: + -- There would also be another task type "No_ACK_Task" which would + -- be the carrier task for those messages not requiring an ACK. + -- This task would call Send_Message.ACK_Not_Required. It is not + -- shown in this test as it is not used. + --::::::::::::::::::::::::::::::::: + + + + task Send_Message is + entry ACK_Required (Message_to_Send: Message_Type); + entry ACK_Not_Required (Message_to_Send: Message_Type); + end Send_Message; + + + -- This is the carrier task. One of these is created for each + -- message that requires ACK + -- + task body Require_ACK_task is + Hold_Message : Message_Type; + + procedure Time_Out (Failed_Message_Number : Sequence_Number) is + begin + -- Take remedial action on the timed-out message + null; -- stub + + Report.Failed ("Optional statements in triggering part" & + " were performed"); + end Time_out; + + begin + accept Message_In (Message_to_Send: Message_Type) do + Hold_Message := Message_to_Send; -- to release caller + end Message_In; + + -- Now put the message out to the Send_Message task and + -- wait (no more than Allowable_Ack_Time) for its completion + -- + select + delay Allowable_ACK_Time; + -- ACK not received in specified time + Time_out (Hold_Message.Message_Number); + then abort + -- If the rendezvous is not completed in the above time, this + -- call is cancelled + -- Note: for this test this call will complete immediately + -- and thus the trigger should be cancelled + Send_Message.ACK_Required (Hold_Message); + end select; + + exception + when others => + Report.Failed ("Unexpected exception in Require_ACK_task"); + end Require_ACK_task; + + + -- This is the Line Driver task + -- + task body Send_Message is + Hold_Non_ACK_Message : Message_Type; + begin + loop + select + accept ACK_Required (Message_to_Send: Message_Type) do + -- Here send the message from within the rendezvous + -- waiting for full transmission to complete + null; -- stub + -- Note: In this test this accept will complete immediately + end ACK_Required; + or + accept ACK_Not_Required (Message_to_Send: Message_Type) do + Hold_Non_ACK_Message := Message_to_Send; + end ACK_Not_Required; + -- Here send the message from outside the rendezvous + null; -- stub + or + terminate; + end select; + end loop; + exception + when others => Report.Failed ("Unexpected exception in Send_Message"); + end Send_Message; + + begin -- declare + -- Build a dummy message + Message_to_Send.Alpha := Dummy_Alpha; + Message_to_Send.Message_Number := 110_693; + + declare + New_Require_ACK_task : acc_Require_ACK_task := + new Require_ACK_task; + begin + -- Create a carrier task for this message and pass the latter in + New_Require_ACK_task.Message_In (Message_to_Send); + end; -- declare + + end; -- declare + + --Once we are out of the above declarative region, all tasks have completed + + TC_Elapsed_Time := Ada.Calendar.Clock - TC_Start_Time; + + -- Check that the test has completed well before the time of the requested + -- delay to ensure the delay was cancelled + -- + if (TC_Elapsed_Time > Allowable_ACK_Time/2) then + Report.Failed ("Triggering delay statement was not cancelled"); + end if; + + Report.Result; +end C960004; |