aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a')
-rw-r--r--gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a334
1 files changed, 334 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c951002.a
new file mode 100644
index 000000000..65b696c4a
--- /dev/null
+++ b/gcc-4.9/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;