| -- 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; |
