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/c951002.a | 334 +++++++++++++++++++++++++++++ 1 file changed, 334 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/c9/c951002.a (limited to 'gcc/testsuite/ada/acats/tests/c9/c951002.a') diff --git a/gcc/testsuite/ada/acats/tests/c9/c951002.a b/gcc/testsuite/ada/acats/tests/c9/c951002.a new file mode 100644 index 000000000..65b696c4a --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/c9/c951002.a @@ -0,0 +1,334 @@ +-- C951002.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: +-- Check that an entry and a procedure within the same protected object +-- will not be executed simultaneously. +-- +-- TEST DESCRIPTION: +-- Two tasks are used. The first calls an entry who's barrier is set +-- and is thus queued. The second calls a procedure in the same +-- protected object. This procedure clears the entry barrier of the +-- first then executes a lengthy compute bound procedure. This is +-- intended to allow a multiprocessor, or a time-slicing implementation +-- of a uniprocessor, to (erroneously) permit the first task to continue +-- while the second is still computing. Flags in each process in the +-- PO are checked to ensure that they do not run out of sequence or in +-- parallel. +-- In the second part of the test another entry and procedure are used +-- but in this case the procedure is started first. A different task +-- calls the entry AFTER the procedure has started. If the entry +-- completes before the procedure the test fails. +-- +-- This test will not be effective on a uniprocessor without time-slicing +-- It is designed to increase the chances of failure on a multiprocessor, +-- or a uniprocessor with time-slicing, if the entry and procedure in a +-- Protected Object are not forced to acquire a single execution +-- resource. It is not guaranteed to fail. +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + +with Report; +with ImpDef; + +procedure C951002 is + + -- These global error flags are used for failure conditions within + -- the protected object. We cannot call Report.Failed (thus Text_io) + -- which would result in a bounded error. + -- + TC_Error_01 : Boolean := false; + TC_Error_02 : Boolean := false; + TC_Error_03 : Boolean := false; + TC_Error_04 : Boolean := false; + TC_Error_05 : Boolean := false; + TC_Error_06 : Boolean := false; + +begin + + Report.Test ("C951002", "Check that a procedure and an entry body " & + "in a protected object will not run concurrently"); + + declare -- encapsulate the test + + task Credit_Message is + entry TC_Start; + end Credit_Message; + + task Credit_Task is + entry TC_Start; + end Credit_Task; + + task Debit_Message is + entry TC_Start; + end Debit_Message; + + task Debit_Task is + entry TC_Start; + end Debit_Task; + + --==================================== + + protected Hold is + + entry Wait_for_CR_Underload; + procedure Clear_CR_Overload; + entry Wait_for_DB_Underload; + procedure Set_DB_Overload; + procedure Clear_DB_Overload; + -- + function TC_Message_is_Queued return Boolean; + + private + Credit_Overloaded : Boolean := true; -- Test starts in overload + Debit_Overloaded : Boolean := false; + -- + TC_CR_Proc_Finished : Boolean := false; + TC_CR_Entry_Finished : Boolean := false; + TC_DB_Proc_Finished : Boolean := false; + TC_DB_Entry_Finished : Boolean := false; + end Hold; + --==================== + protected body Hold is + + entry Wait_for_CR_Underload when not Credit_Overloaded is + begin + -- The barrier must only be re-evaluated at the end of the + -- of the execution of the procedure, also while the procedure + -- is executing this entry body must not be executed + if not TC_CR_Proc_Finished then + TC_Error_01 := true; -- Set error indicator + end if; + TC_CR_Entry_Finished := true; + end Wait_for_CR_Underload ; + + -- This is the procedure which should NOT be able to run in + -- parallel with the entry body + -- + procedure Clear_CR_Overload is + begin + + -- The entry body must not be executed until this procedure + -- is completed. + if TC_CR_Entry_Finished then + TC_Error_02 := true; -- Set error indicator + end if; + Credit_Overloaded := false; -- clear the entry barrier + + -- Execute an implementation defined compute bound routine which + -- is designed to run long enough to allow a task switch on a + -- time-sliced uniprocessor, or for a multiprocessor to pick up + -- another task. + -- + ImpDef.Exceed_Time_Slice; + + -- Again, the entry body must not be executed until the current + -- procedure is completed. + -- + if TC_CR_Entry_Finished then + TC_Error_03 := true; -- Set error indicator + end if; + TC_CR_Proc_Finished := true; + + end Clear_CR_Overload; + + --============ + -- The following subprogram and entry body are used in the second + -- part of the test + + entry Wait_for_DB_Underload when not Debit_Overloaded is + begin + -- By the time the task that calls this entry is allowed access to + -- the queue the barrier, which starts off as open, will be closed + -- by the Set_DB_Overload procedure. It is only reopened + -- at the end of the test + if not TC_DB_Proc_Finished then + TC_Error_04 := true; -- Set error indicator + end if; + TC_DB_Entry_Finished := true; + end Wait_for_DB_Underload ; + + + procedure Set_DB_Overload is + begin + -- The task timing is such that this procedure should be started + -- before the entry is called. Thus the entry should be blocked + -- until the end of this procedure which then sets the barrier + -- + if TC_DB_Entry_Finished then + TC_Error_05 := true; -- Set error indicator + end if; + + -- Execute an implementation defined compute bound routine which + -- is designed to run long enough to allow a task switch on a + -- time-sliced uniprocessor, or for a multiprocessor to pick up + -- another task + -- + ImpDef.Exceed_Time_Slice; + + Debit_Overloaded := true; -- set the entry barrier + + if TC_DB_Entry_Finished then + TC_Error_06 := true; -- Set error indicator + end if; + TC_DB_Proc_Finished := true; + + end Set_DB_Overload; + + procedure Clear_DB_Overload is + begin + Debit_Overloaded := false; -- open the entry barrier + end Clear_DB_Overload; + + function TC_Message_is_Queued return Boolean is + begin + + -- returns true when one message arrives on the queue + return (Wait_for_CR_Underload'Count = 1); + + end TC_Message_is_Queued ; + + end Hold; + + --==================================== + + task body Credit_Message is + begin + accept TC_Start; + --:: some application processing. Part of the process finds that + -- the Overload threshold has been exceeded for the Credit + -- application. This message task queues itself on a queue + -- waiting till the overload in no longer in effect + Hold.Wait_for_CR_Underload; + exception + when others => + Report.Failed ("Unexpected Exception in Credit_Message Task"); + end Credit_Message; + + task body Credit_Task is + begin + accept TC_Start; + -- Application code here (not shown) determines that the + -- underload threshold has been reached + Hold.Clear_CR_Overload; + exception + when others => + Report.Failed ("Unexpected Exception in Credit_Task"); + end Credit_Task; + + --============== + + -- The following two tasks are used in the second part of the test + + task body Debit_Message is + begin + accept TC_Start; + --:: some application processing. Part of the process finds that + -- the Overload threshold has been exceeded for the Debit + -- application. This message task queues itself on a queue + -- waiting till the overload is no longer in effect + -- + Hold.Wait_for_DB_Underload; + exception + when others => + Report.Failed ("Unexpected Exception in Debit_Message Task"); + end Debit_Message; + + task body Debit_Task is + begin + accept TC_Start; + -- Application code here (not shown) determines that the + -- underload threshold has been reached + Hold.Set_DB_Overload; + exception + when others => + Report.Failed ("Unexpected Exception in Debit_Task"); + end Debit_Task; + + begin -- declare + + Credit_Message.TC_Start; + + -- Wait until the message is queued on the entry before starting + -- the Credit_Task + while not Hold.TC_Message_is_Queued loop + delay ImpDef.Long_Minimum_Task_Switch; + end loop; + -- + Credit_Task.TC_Start; + + -- Ensure the first part of the test is complete before continuing + while not (Credit_Message'terminated and Credit_Task'terminated) loop + delay ImpDef.Long_Minimum_Task_Switch; + end loop; + + --====================================================== + -- Second part of the test + + + Debit_Task.TC_Start; + + -- Delay long enough to allow a task switch to the Debit_Task and + -- for it to reach the accept statement and call Hold.Set_DB_Overload + -- before starting Debit_Message + -- + delay ImpDef.Long_Switch_To_New_Task; + + Debit_Message.TC_Start; + + while not Debit_Task'terminated loop + delay ImpDef.Long_Minimum_Task_Switch; + end loop; + + Hold.Clear_DB_Overload; -- Allow completion + + end; -- declare (encapsulation) + + if TC_Error_01 then + Report.Failed ("Wait_for_CR_Underload executed out of sequence"); + end if; + if TC_Error_02 then + Report.Failed ("Credit: Entry executed before procedure"); + end if; + if TC_Error_03 then + Report.Failed ("Credit: Entry executed in parallel"); + end if; + if TC_Error_04 then + Report.Failed ("Wait_for_DB_Underload executed out of sequence"); + end if; + if TC_Error_05 then + Report.Failed ("Debit: Entry executed before procedure"); + end if; + if TC_Error_06 then + Report.Failed ("Debit: Entry executed in parallel"); + end if; + + Report.Result; + +end C951002; -- cgit v1.2.3