Subversion Repositories scarts

-- C93005F.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 IF AN EXCEPTION IS RAISED IN A DECLARATIVE PART OR PACKAGE

-- SPECIFICATION, A TASK DECLARED IN THE SAME DECLARATIVE PART BECOMES

-- COMPLETED BEFORE IT HAS BEEN ACTIVATED; ANY TASKS AWAITING A

-- RENDEZVOUS WITH THE COMPLETED RECEIVE TASKING_ERROR.

-- CASE 4: TASKS IN STATEMENT PART OF A BLOCK.  THE TASKS DEPEND ON THE

--         DECLARATIVE PART.

-- RAC 19-MAR-1985

-- JBG 06/03/85

-- EG  10/30/85  ELIMINATE THE USE OF NUMERIC_ERROR IN TEST.

-- PWN 09/11/94  REMOVED PRAGMA PRIORITY FOR ADA 9X.

-- RLB 06/29/01  CORRECTED TO ALLOW AGGRESSIVE OPTIMIZATION.

WITH REPORT; USE REPORT;

WITH SYSTEM; USE SYSTEM;

PRAGMA ELABORATE (REPORT);

PACKAGE C93005F_PK1 IS

     -- THIS TYPE OF TASK IS ALWAYS UNACTIVATED.

     TASK TYPE UNACTIVATED IS

          ENTRY E;

     END UNACTIVATED;

     TYPE ACC_UNACTIVATED IS ACCESS UNACTIVATED;

     TYPE BAD_REC IS

          RECORD

               T : UNACTIVATED;

               I : POSITIVE := IDENT_INT(0); -- RAISE CONSTRAINT_ERROR.

          END RECORD;

     TYPE ACC_BAD_REC IS ACCESS BAD_REC;

     -- *******************************************

     -- DEFINITIONS FOR MUST NOT BE TERMINATED TASKS

     -- *******************************************

     --

     -- THIS SET OF DECLARATIONS DEFINES A RECORD TYPE MNT (MUST NOT

     -- TERMINATE).  WHENEVER SUCH A RECORD IS DECLARED, A COUNT IS

     -- INCREMENTED AND A TASK IS CREATED.   THE TASK WILL DECREMENT THE

     -- COUNT UNLESS IT IS INCORRECTLY AND PREMATURELY TERMINATED.

     -- THE ROUTINE CHECK IS CALLED TO VERIFY WHETHER THE COUNT

     -- HAS RETURNED TO 0 (ALL MNT TASKS GOT A CHANCE TO DO THEIR

     -- DECREMENT).

     -- AN MNT TASK.   SUCH TASKS MUST NOT BE TERMINATED

     -- BY ANYONE BUT THEMSELVES.

     --

     TASK TYPE MNT_TASK IS

     END MNT_TASK;

     FUNCTION F RETURN INTEGER;

     -- THE RECORD THAT IS DECLARED TO HOLD AN MNT TASK

     -- AND FORCE CALLING F BEFORE CREATING THE TASK.

     -- F INCREMENTS THE COUNT, THE TASK DECREMENTS THE

     -- COUNT.

     --

     TYPE MNT IS

          RECORD

               DUMMY : INTEGER :=  F;

               T     : MNT_TASK;

          END RECORD;

     PROCEDURE CHECK;

     -- *******************************************

     -- END OF DEFINITIONS FOR MUST NOT BE TERMINATED TASKS

     -- *******************************************

END C93005F_PK1;

with Impdef;

PACKAGE BODY C93005F_PK1 IS

-- THIS TASK IS CALLED IF AN UNACTIVATED TASK

-- IS EVER INCORRECTLY ACTIVATED.  IT REPORTS FAILURE.

     TASK T IS

          ENTRY E;

     END;

     -- ***********************************************

     -- START OF DEFINITIONS FOR MUST NOT TERMINATE TASKS

     -- ***********************************************

-- COUNT OF TASKS THAT MUST NOT BE TERMINATED AND

-- ARE STILL ACTIVE.

     MNT_COUNT : INTEGER := 0;

-- TASK TO SYNCHRONIZE THE MNT_COUNT VARIABLE

     TASK MNT_COUNTER IS

          ENTRY INCR;

          ENTRY DECR;

     END MNT_COUNTER;

-- SYNCHRONIZING TASK

     TASK BODY MNT_COUNTER IS

     BEGIN

          LOOP

               SELECT

                    ACCEPT INCR DO

                         MNT_COUNT := MNT_COUNT +1;

                    END INCR;

               OR  ACCEPT DECR DO

                         MNT_COUNT := MNT_COUNT -1;

                    END DECR;

               OR  TERMINATE;

               END SELECT;

          END LOOP;

     END MNT_COUNTER;

-- INCREMENT THE MNT_COUNT WHEN A TASK IS CREATED

--

     FUNCTION F RETURN INTEGER IS

     BEGIN

          MNT_COUNTER.INCR;

          RETURN 0;

     END F;

-- CHECK THAT THE MUST NOT BE TERMINATED TASKS ARE

-- NOT YET TERMINATED AND THAT THE SYNCRHONIZING TASK

-- ITSELF IS NOT TERMINATED.

--

     PROCEDURE CHECK IS

     BEGIN

          IF MNT_COUNT /= 0 OR MNT_COUNTER'TERMINATED THEN

               FAILED ("SOME MUST-NOT-TERMINATE TASK WAS PREMATURELY " &

                       "TERMINATED");

          END IF;

-- RESET THE COUNT FOR THE NEXT SUBTEST:

          MNT_COUNT := 0;

     END CHECK;

-- A MUST NOT BE TERMINATED TASK.  DELAY LONG ENOUGH

-- TO BE THE LAST TASK OF A SCOPE TO TERMINATE.   THEN

-- DECREMENT THE COUNTER.

--

     TASK BODY MNT_TASK IS

     BEGIN

          DELAY 5.0 * Impdef.One_Second;

          MNT_COUNTER.DECR;

     END MNT_TASK;

     -- ***********************************************

     -- END OF DEFINITIONS FOR MUST NOT TERMINATE TASKS

     -- ***********************************************

     TASK BODY T IS

     BEGIN

          LOOP

               SELECT

                    ACCEPT E DO

                         FAILED ("SOME TYPE U TASK WAS ACTIVATED");

                    END E;

               OR   TERMINATE;

               END SELECT;

          END LOOP;

     END T;

     -- TASKS OF TYPE UNACTIVATED MUST NEVER BE ACTIVATED.

     --

     TASK BODY UNACTIVATED IS

     BEGIN

          T.E;

     END UNACTIVATED;

END C93005F_PK1;

WITH REPORT, C93005F_PK1;

USE  REPORT, C93005F_PK1;

WITH SYSTEM; USE SYSTEM;

PROCEDURE C93005F IS

BEGIN

     TEST("C93005F", "TEST EXCEPTIONS TERMINATE NOT YET ACTIVATED " &

                     "TASKS");

     COMMENT("SUBTEST 4: TASK IN STATEMENT PART OF BLOCK");

     COMMENT("  THE TASKS DEPEND ON THE DECLARATIVE PART");

B41: DECLARE

          X : MNT;

     BEGIN

B42:      DECLARE

               TYPE LOCAL_ACC IS ACCESS BAD_REC;

               Y : MNT;

               PTR : LOCAL_ACC;

               TYPE ACC_MNT IS ACCESS MNT;

               Z : ACC_MNT;

          BEGIN

               Z  := NEW MNT;

               PTR := NEW BAD_REC;

               IF PTR.I /= REPORT.IDENT_INT(0) THEN

                  FAILED ("EXCEPTION NOT RAISED, VALUE CHANGED");

               ELSE

                  FAILED ("EXCEPTION NOT RAISED, CONSTRAINT IGNORED");

               END IF;

          EXCEPTION

               WHEN CONSTRAINT_ERROR => NULL;

               WHEN OTHERS =>

                    FAILED ("WRONG EXCEPTION IN B42");

          END B42;

          COMMENT("SUBTEST 4: COMPLETED");

     EXCEPTION

          WHEN OTHERS =>

               FAILED ("EXCEPTION NOT ABSORBED");

     END B41;

     CHECK;

     RESULT;

EXCEPTION

     WHEN OTHERS =>

          FAILED ("EXCEPTION NOT ABSORBED");

          RESULT;

END C93005F;