-- C94007A.ADA
|
-- C94007A.ADA
|
|
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- CHECK THAT A TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE
|
-- CHECK THAT A TASK THAT IS DECLARED IN A NON-LIBRARY PACKAGE
|
-- (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
|
-- (SPECIFICATION OR BODY) DOES NOT "DEPEND" ON THE PACKAGE,
|
-- BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
|
-- BUT ON THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM BODY,
|
-- OR TASK BODY.
|
-- OR TASK BODY.
|
-- SUBTESTS ARE:
|
-- SUBTESTS ARE:
|
-- (A) A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK.
|
-- (A) A SIMPLE TASK OBJECT, IN A VISIBLE PART, IN A BLOCK.
|
-- (B) AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION.
|
-- (B) AN ARRAY OF TASK OBJECT, IN A PRIVATE PART, IN A FUNCTION.
|
-- (C) AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY,
|
-- (C) AN ARRAY OF RECORD OF TASK OBJECT, IN A PACKAGE BODY,
|
-- IN A TASK BODY.
|
-- IN A TASK BODY.
|
|
|
-- HISTORY:
|
-- HISTORY:
|
-- JRK 10/13/81
|
-- JRK 10/13/81
|
-- SPS 11/21/82
|
-- SPS 11/21/82
|
-- DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER
|
-- DHH 09/07/88 REVISED HEADER, ADDED EXCEPTION HANDLERS ON OUTER
|
-- BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A
|
-- BLOCKS, AND ADDED CASE TO INSURE THAT LEAVING A
|
-- PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS.
|
-- PACKAGE VIA AN EXCEPTION WOULD NOT ABORT TASKS.
|
-- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
|
-- PWN 01/31/95 REMOVED PRAGMA PRIORITY FOR ADA 9X.
|
|
|
with Impdef;
|
with Impdef;
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
WITH SYSTEM; USE SYSTEM;
|
WITH SYSTEM; USE SYSTEM;
|
PROCEDURE C94007A IS
|
PROCEDURE C94007A IS
|
|
|
TASK TYPE SYNC IS
|
TASK TYPE SYNC IS
|
ENTRY ID (C : CHARACTER);
|
ENTRY ID (C : CHARACTER);
|
ENTRY INNER;
|
ENTRY INNER;
|
ENTRY OUTER;
|
ENTRY OUTER;
|
END SYNC;
|
END SYNC;
|
|
|
TASK BODY SYNC IS
|
TASK BODY SYNC IS
|
ID_C : CHARACTER;
|
ID_C : CHARACTER;
|
BEGIN
|
BEGIN
|
ACCEPT ID (C : CHARACTER) DO
|
ACCEPT ID (C : CHARACTER) DO
|
ID_C := C;
|
ID_C := C;
|
END ID;
|
END ID;
|
DELAY 1.0 * Impdef.One_Second;
|
DELAY 1.0 * Impdef.One_Second;
|
SELECT
|
SELECT
|
ACCEPT OUTER;
|
ACCEPT OUTER;
|
OR
|
OR
|
DELAY 120.0 * Impdef.One_Second;
|
DELAY 120.0 * Impdef.One_Second;
|
FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
|
FAILED ("PROBABLY BLOCKED - (" & ID_C & ')');
|
END SELECT;
|
END SELECT;
|
ACCEPT INNER;
|
ACCEPT INNER;
|
END SYNC;
|
END SYNC;
|
|
|
|
|
BEGIN
|
BEGIN
|
TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " &
|
TEST ("C94007A", "CHECK THAT A TASK THAT IS DECLARED IN A " &
|
"NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
|
"NON-LIBRARY PACKAGE (SPECIFICATION OR BODY) " &
|
"DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
|
"DOES NOT ""DEPEND"" ON THE PACKAGE, BUT ON " &
|
"THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
|
"THE INNERMOST ENCLOSING BLOCK, SUBPROGRAM " &
|
"BODY, OR TASK BODY");
|
"BODY, OR TASK BODY");
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (A)
|
DECLARE -- (A)
|
|
|
S : SYNC;
|
S : SYNC;
|
|
|
BEGIN -- (A)
|
BEGIN -- (A)
|
|
|
S.ID ('A');
|
S.ID ('A');
|
|
|
DECLARE
|
DECLARE
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
TASK T IS
|
TASK T IS
|
ENTRY E;
|
ENTRY E;
|
END T;
|
END T;
|
END PKG;
|
END PKG;
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
TASK BODY T IS
|
TASK BODY T IS
|
BEGIN
|
BEGIN
|
S.INNER; -- PROBABLE INNER BLOCK POINT.
|
S.INNER; -- PROBABLE INNER BLOCK POINT.
|
END T;
|
END T;
|
END PKG; -- PROBABLE OUTER BLOCK POINT.
|
END PKG; -- PROBABLE OUTER BLOCK POINT.
|
|
|
BEGIN
|
BEGIN
|
|
|
S.OUTER;
|
S.OUTER;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN TASKING_ERROR => NULL;
|
WHEN TASKING_ERROR => NULL;
|
END;
|
END;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED("UNEXPECTED EXCEPTION RAISED - A");
|
FAILED("UNEXPECTED EXCEPTION RAISED - A");
|
END; -- (A)
|
END; -- (A)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (B)
|
DECLARE -- (B)
|
|
|
S : SYNC;
|
S : SYNC;
|
|
|
I : INTEGER;
|
I : INTEGER;
|
|
|
FUNCTION F RETURN INTEGER IS
|
FUNCTION F RETURN INTEGER IS
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
PRIVATE
|
PRIVATE
|
TASK TYPE TT IS
|
TASK TYPE TT IS
|
ENTRY E;
|
ENTRY E;
|
END TT;
|
END TT;
|
A : ARRAY (1..1) OF TT;
|
A : ARRAY (1..1) OF TT;
|
END PKG;
|
END PKG;
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
TASK BODY TT IS
|
TASK BODY TT IS
|
BEGIN
|
BEGIN
|
S.INNER; -- PROBABLE INNER BLOCK POINT.
|
S.INNER; -- PROBABLE INNER BLOCK POINT.
|
END TT;
|
END TT;
|
END PKG; -- PROBABLE OUTER BLOCK POINT.
|
END PKG; -- PROBABLE OUTER BLOCK POINT.
|
|
|
BEGIN -- F
|
BEGIN -- F
|
|
|
S.OUTER;
|
S.OUTER;
|
RETURN 0;
|
RETURN 0;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN TASKING_ERROR => RETURN 0;
|
WHEN TASKING_ERROR => RETURN 0;
|
END F;
|
END F;
|
|
|
BEGIN -- (B)
|
BEGIN -- (B)
|
|
|
S.ID ('B');
|
S.ID ('B');
|
I := F;
|
I := F;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED("UNEXPECTED EXCEPTION RAISED - B");
|
FAILED("UNEXPECTED EXCEPTION RAISED - B");
|
|
|
END; -- (B)
|
END; -- (B)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (C)
|
DECLARE -- (C)
|
|
|
S : SYNC;
|
S : SYNC;
|
|
|
BEGIN -- (C)
|
BEGIN -- (C)
|
|
|
S.ID ('C');
|
S.ID ('C');
|
|
|
DECLARE
|
DECLARE
|
|
|
TASK TSK IS
|
TASK TSK IS
|
END TSK;
|
END TSK;
|
|
|
TASK BODY TSK IS
|
TASK BODY TSK IS
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
END PKG;
|
END PKG;
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
TASK TYPE TT IS
|
TASK TYPE TT IS
|
ENTRY E;
|
ENTRY E;
|
END TT;
|
END TT;
|
|
|
TYPE RT IS
|
TYPE RT IS
|
RECORD
|
RECORD
|
T : TT;
|
T : TT;
|
END RECORD;
|
END RECORD;
|
|
|
AR : ARRAY (1..1) OF RT;
|
AR : ARRAY (1..1) OF RT;
|
|
|
TASK BODY TT IS
|
TASK BODY TT IS
|
BEGIN
|
BEGIN
|
S.INNER; -- PROBABLE INNER BLOCK POINT.
|
S.INNER; -- PROBABLE INNER BLOCK POINT.
|
END TT;
|
END TT;
|
END PKG; -- PROBABLE OUTER BLOCK POINT.
|
END PKG; -- PROBABLE OUTER BLOCK POINT.
|
|
|
BEGIN -- TSK
|
BEGIN -- TSK
|
|
|
S.OUTER;
|
S.OUTER;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN TASKING_ERROR => NULL;
|
WHEN TASKING_ERROR => NULL;
|
END TSK;
|
END TSK;
|
|
|
BEGIN
|
BEGIN
|
NULL;
|
NULL;
|
END;
|
END;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED("UNEXPECTED EXCEPTION RAISED - C");
|
FAILED("UNEXPECTED EXCEPTION RAISED - C");
|
END; -- (C)
|
END; -- (C)
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (D)
|
DECLARE -- (D)
|
|
|
GLOBAL : INTEGER := IDENT_INT(5);
|
GLOBAL : INTEGER := IDENT_INT(5);
|
|
|
BEGIN -- (D)
|
BEGIN -- (D)
|
|
|
DECLARE
|
DECLARE
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
TASK T IS
|
TASK T IS
|
ENTRY E;
|
ENTRY E;
|
END T;
|
END T;
|
|
|
TASK T1 IS
|
TASK T1 IS
|
END T1;
|
END T1;
|
END PKG;
|
END PKG;
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
TASK BODY T IS
|
TASK BODY T IS
|
BEGIN
|
BEGIN
|
ACCEPT E DO
|
ACCEPT E DO
|
RAISE CONSTRAINT_ERROR;
|
RAISE CONSTRAINT_ERROR;
|
END E;
|
END E;
|
END T;
|
END T;
|
|
|
TASK BODY T1 IS
|
TASK BODY T1 IS
|
BEGIN
|
BEGIN
|
DELAY 120.0 * Impdef.One_Second;
|
DELAY 120.0 * Impdef.One_Second;
|
GLOBAL := IDENT_INT(1);
|
GLOBAL := IDENT_INT(1);
|
END T1;
|
END T1;
|
|
|
BEGIN
|
BEGIN
|
T.E;
|
T.E;
|
|
|
END PKG;
|
END PKG;
|
USE PKG;
|
USE PKG;
|
BEGIN
|
BEGIN
|
NULL;
|
NULL;
|
END;
|
END;
|
|
|
EXCEPTION
|
EXCEPTION
|
WHEN CONSTRAINT_ERROR =>
|
WHEN CONSTRAINT_ERROR =>
|
IF GLOBAL /= IDENT_INT(1) THEN
|
IF GLOBAL /= IDENT_INT(1) THEN
|
FAILED("TASK NOT COMPLETED");
|
FAILED("TASK NOT COMPLETED");
|
END IF;
|
END IF;
|
|
|
WHEN OTHERS =>
|
WHEN OTHERS =>
|
FAILED("UNEXPECTED EXCEPTION RAISED - D");
|
FAILED("UNEXPECTED EXCEPTION RAISED - D");
|
END; -- (D)
|
END; -- (D)
|
|
|
RESULT;
|
RESULT;
|
END C94007A;
|
END C94007A;
|
|
|
