diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c9/c951002.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c9/c951002.a | 334 |
1 files changed, 0 insertions, 334 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c9/c951002.a b/gcc/testsuite/ada/acats/tests/c9/c951002.a deleted file mode 100644 index 8ccb2d012fe..00000000000 --- a/gcc/testsuite/ada/acats/tests/c9/c951002.a +++ /dev/null @@ -1,334 +0,0 @@ --- 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.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.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.Switch_To_New_Task; - - Debit_Message.TC_Start; - - while not Debit_Task'terminated loop - delay ImpDef.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; |