WITH IMPDEF;
WITH REPORT; USE REPORT;
WITH SYSTEM; USE SYSTEM;
PROCEDURE C9A007A IS
TASK_NOT_ABORTED : BOOLEAN := FALSE;
TEST_VALID : BOOLEAN := TRUE ;
BEGIN
TEST ( "C9A007A" , "CHECK THAT A TASK MAY ABORT A TASK" &
" IT DEPENDS ON" );
DECLARE
TASK REGISTER IS
ENTRY BIRTHS_AND_DEATHS;
ENTRY SYNC1;
ENTRY SYNC2;
END REGISTER;
TASK BODY REGISTER IS
TASK TYPE SECONDARY IS
ENTRY WAIT_INDEFINITELY;
END SECONDARY;
TASK TYPE T_TYPE1 IS
ENTRY E;
END T_TYPE1;
TASK TYPE T_TYPE2 IS
ENTRY E;
END T_TYPE2;
T_OBJECT1 : T_TYPE1;
T_OBJECT2 : T_TYPE2;
TASK BODY SECONDARY IS
BEGIN
SYNC1;
ABORT T_OBJECT1;
DELAY 0.0;
TASK_NOT_ABORTED := TRUE;
END SECONDARY;
TASK BODY T_TYPE1 IS
TYPE ACCESS_TO_TASK IS ACCESS SECONDARY;
BEGIN
DECLARE
DEPENDENT_BY_ACCESS : ACCESS_TO_TASK :=
NEW SECONDARY ;
BEGIN
NULL;
END;
BIRTHS_AND_DEATHS;
TASK_NOT_ABORTED := TRUE;
END T_TYPE1;
TASK BODY T_TYPE2 IS
TASK INNER_TASK IS
ENTRY WAIT_INDEFINITELY;
END INNER_TASK;
TASK BODY INNER_TASK IS
BEGIN
SYNC2;
ABORT T_OBJECT2;
DELAY 0.0;
TASK_NOT_ABORTED := TRUE;
END INNER_TASK;
BEGIN
BIRTHS_AND_DEATHS;
TASK_NOT_ABORTED := TRUE;
END T_TYPE2;
BEGIN
DECLARE
OLD_COUNT : INTEGER := 0;
BEGIN
FOR I IN 1..5 LOOP
EXIT WHEN BIRTHS_AND_DEATHS'COUNT = 2;
DELAY 10.0 * Impdef.One_Second;
END LOOP;
OLD_COUNT := BIRTHS_AND_DEATHS'COUNT;
IF OLD_COUNT = 2 THEN
ACCEPT SYNC1;
DELAY IMPDEF.CLEAR_READY_QUEUE;
BEGIN
T_OBJECT1.E;
FAILED( "T_OBJECT1.E DID NOT RAISE" &
" TASKING_ERROR" );
EXCEPTION
WHEN TASKING_ERROR =>
NULL;
WHEN OTHERS =>
FAILED("OTHER EXCEPTION RAISED - 1");
END;
IF T_OBJECT1'CALLABLE THEN
FAILED( "T_OBJECT1'CALLABLE = TRUE" );
END IF;
IF OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
THEN
FAILED( "TASK#1 NOT REMOVED FROM QUEUE" );
END IF;
OLD_COUNT := BIRTHS_AND_DEATHS'COUNT;
ACCEPT SYNC2;
DELAY IMPDEF.CLEAR_READY_QUEUE;
BEGIN
T_OBJECT2.E;
FAILED( "T_OBJECT2.E DID NOT RAISE" &
" TASKING_ERROR" );
EXCEPTION
WHEN TASKING_ERROR =>
NULL;
WHEN OTHERS =>
FAILED("OTHER EXCEPTION RAISED - 2");
END;
IF T_OBJECT2'CALLABLE THEN
FAILED( "T_OBJECT2'CALLABLE = TRUE" );
END IF;
IF OLD_COUNT - BIRTHS_AND_DEATHS'COUNT /= 1
THEN
FAILED( "TASK#2 NOT REMOVED FROM QUEUE" );
END IF;
IF BIRTHS_AND_DEATHS'COUNT /= 0 THEN
FAILED( "SOME TASKS STILL QUEUED" );
END IF;
ELSE
COMMENT( "LINEUP NOT COMPLETE (AFTER 50 S.)" );
TEST_VALID := FALSE;
END IF;
END;
WHILE BIRTHS_AND_DEATHS'COUNT > 0 LOOP
ACCEPT BIRTHS_AND_DEATHS;
END LOOP;
END REGISTER;
BEGIN
NULL;
END;
IF TEST_VALID AND TASK_NOT_ABORTED THEN
FAILED( "SOME TASKS NOT ABORTED" );
END IF;
RESULT;
END C9A007A;