Subversion Repositories scarts

-- C9A007A.ADA
 
--                             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.
--*
-- CHECK THAT A TASK MAY ABORT A TASK IT DEPENDS ON.
 
 
-- RM 5/26/82
-- RM 7/02/82
-- SPS 11/21/82
-- JBG 2/27/84
-- JBG 3/8/84
-- PWN 11/30/94 REMOVED PRAGMA PRIORITY INSTANCES FOR ADA 9X.
-- EDS 08/04/98 ENSURE THAT ABORTED TASKS HAVE TIME TO EFFECT THEIR ABORTIONS.
 
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; 
                                     -- DURING THIS SUSPENSION
                                     --     MOST OF THE TASKS
                                     --     ARE ABORTED   (FIRST
                                     --     TASK #1    -- T_OBJECT1 --
                                     --     THEN  #2 ).
 
 
                    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; 
                                     -- DURING THIS SUSPENSION
                                     --     MOST OF THE TASKS
                                     --     ARE ABORTED   (FIRST
                                     --     TASK #1     -- T_OBJECT1 --
                                     --     THEN  #2 ).
 
 
                    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;   -- ALLOWING  ABORT#1
 
                         DELAY IMPDEF.CLEAR_READY_QUEUE;
 
                         -- CHECK THAT  #1  WAS ABORTED  -  3 WAYS:
 
                         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;   -- ALLOWING  ABORT#2
 
                         DELAY IMPDEF.CLEAR_READY_QUEUE;
 
                         -- CHECK THAT  #2  WAS ABORTED  -  3 WAYS:
 
                         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;