-- C95071A.ADA
|
-- C95071A.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.
|
--*
|
--*
|
-- CHECK THAT OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN
|
-- CHECK THAT OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN
|
-- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL
|
-- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL
|
-- PARAMETER OF ANY MODE. SUBTESTS ARE:
|
-- PARAMETER OF ANY MODE. SUBTESTS ARE:
|
-- (A) INTEGER ACCESS TYPE.
|
-- (A) INTEGER ACCESS TYPE.
|
-- (B) ARRAY ACCESS TYPE.
|
-- (B) ARRAY ACCESS TYPE.
|
-- (C) RECORD ACCESS TYPE.
|
-- (C) RECORD ACCESS TYPE.
|
|
|
-- JWC 7/11/85
|
-- JWC 7/11/85
|
|
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
PROCEDURE C95071A IS
|
PROCEDURE C95071A IS
|
|
|
BEGIN
|
BEGIN
|
|
|
TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &
|
TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &
|
"MAY BE USED IN ASSIGNMENT CONTEXTS");
|
"MAY BE USED IN ASSIGNMENT CONTEXTS");
|
|
|
--------------------------------------------------
|
--------------------------------------------------
|
|
|
DECLARE -- (A)
|
DECLARE -- (A)
|
|
|
TYPE PTRINT IS ACCESS INTEGER;
|
TYPE PTRINT IS ACCESS INTEGER;
|
PI : PTRINT;
|
PI : PTRINT;
|
|
|
TASK TA IS
|
TASK TA IS
|
ENTRY EA (PI : IN PTRINT);
|
ENTRY EA (PI : IN PTRINT);
|
END TA;
|
END TA;
|
|
|
TASK BODY TA IS
|
TASK BODY TA IS
|
BEGIN
|
BEGIN
|
ACCEPT EA (PI : IN PTRINT) DO
|
ACCEPT EA (PI : IN PTRINT) DO
|
DECLARE
|
DECLARE
|
TASK TA1 IS
|
TASK TA1 IS
|
ENTRY EA1 (I : OUT INTEGER);
|
ENTRY EA1 (I : OUT INTEGER);
|
ENTRY EA2 (I : IN OUT INTEGER);
|
ENTRY EA2 (I : IN OUT INTEGER);
|
END TA1;
|
END TA1;
|
|
|
TASK BODY TA1 IS
|
TASK BODY TA1 IS
|
BEGIN
|
BEGIN
|
ACCEPT EA1 (I : OUT INTEGER) DO
|
ACCEPT EA1 (I : OUT INTEGER) DO
|
I := 7;
|
I := 7;
|
END EA1;
|
END EA1;
|
|
|
ACCEPT EA2 (I : IN OUT INTEGER) DO
|
ACCEPT EA2 (I : IN OUT INTEGER) DO
|
I := I + 1;
|
I := I + 1;
|
END EA2;
|
END EA2;
|
END TA1;
|
END TA1;
|
|
|
BEGIN
|
BEGIN
|
TA1.EA1 (PI.ALL);
|
TA1.EA1 (PI.ALL);
|
TA1.EA2 (PI.ALL);
|
TA1.EA2 (PI.ALL);
|
PI.ALL := PI.ALL + 1;
|
PI.ALL := PI.ALL + 1;
|
IF (PI.ALL /= 9) THEN
|
IF (PI.ALL /= 9) THEN
|
FAILED ("ASSIGNMENT TO COMPONENT OF " &
|
FAILED ("ASSIGNMENT TO COMPONENT OF " &
|
"INTEGER ACCESS PARAMETER " &
|
"INTEGER ACCESS PARAMETER " &
|
"FAILED");
|
"FAILED");
|
END IF;
|
END IF;
|
END;
|
END;
|
END EA;
|
END EA;
|
END TA;
|
END TA;
|
|
|
BEGIN -- (A)
|
BEGIN -- (A)
|
|
|
PI := NEW INTEGER'(0);
|
PI := NEW INTEGER'(0);
|
TA.EA (PI);
|
TA.EA (PI);
|
|
|
END; -- (A)
|
END; -- (A)
|
|
|
---------------------------------------------
|
---------------------------------------------
|
|
|
DECLARE -- (B)
|
DECLARE -- (B)
|
|
|
TYPE TBL IS ARRAY (1..3) OF INTEGER;
|
TYPE TBL IS ARRAY (1..3) OF INTEGER;
|
TYPE PTRTBL IS ACCESS TBL;
|
TYPE PTRTBL IS ACCESS TBL;
|
PT : PTRTBL;
|
PT : PTRTBL;
|
|
|
TASK TB IS
|
TASK TB IS
|
ENTRY EB (PT : IN PTRTBL);
|
ENTRY EB (PT : IN PTRTBL);
|
END TB;
|
END TB;
|
|
|
TASK BODY TB IS
|
TASK BODY TB IS
|
BEGIN
|
BEGIN
|
ACCEPT EB (PT : IN PTRTBL) DO
|
ACCEPT EB (PT : IN PTRTBL) DO
|
DECLARE
|
DECLARE
|
TASK TB1 IS
|
TASK TB1 IS
|
ENTRY EB1 (T : OUT TBL);
|
ENTRY EB1 (T : OUT TBL);
|
ENTRY EB2 (T : IN OUT TBL);
|
ENTRY EB2 (T : IN OUT TBL);
|
ENTRY EB3 (I : OUT INTEGER);
|
ENTRY EB3 (I : OUT INTEGER);
|
ENTRY EB4 (I : IN OUT INTEGER);
|
ENTRY EB4 (I : IN OUT INTEGER);
|
END TB1;
|
END TB1;
|
|
|
TASK BODY TB1 IS
|
TASK BODY TB1 IS
|
BEGIN
|
BEGIN
|
ACCEPT EB1 (T : OUT TBL) DO
|
ACCEPT EB1 (T : OUT TBL) DO
|
T := (1,2,3);
|
T := (1,2,3);
|
END EB1;
|
END EB1;
|
|
|
ACCEPT EB2 (T : IN OUT TBL) DO
|
ACCEPT EB2 (T : IN OUT TBL) DO
|
T(3) := T(3) - 1;
|
T(3) := T(3) - 1;
|
END EB2;
|
END EB2;
|
|
|
ACCEPT EB3 (I : OUT INTEGER) DO
|
ACCEPT EB3 (I : OUT INTEGER) DO
|
I := 7;
|
I := 7;
|
END EB3;
|
END EB3;
|
|
|
ACCEPT EB4 (I : IN OUT INTEGER) DO
|
ACCEPT EB4 (I : IN OUT INTEGER) DO
|
I := I + 1;
|
I := I + 1;
|
END EB4;
|
END EB4;
|
END TB1;
|
END TB1;
|
|
|
BEGIN
|
BEGIN
|
TB1.EB1 (PT.ALL); -- (1,2,3)
|
TB1.EB1 (PT.ALL); -- (1,2,3)
|
TB1.EB2 (PT.ALL); -- (1,2,2)
|
TB1.EB2 (PT.ALL); -- (1,2,2)
|
TB1.EB3 (PT(2)); -- (1,7,2)
|
TB1.EB3 (PT(2)); -- (1,7,2)
|
TB1.EB4 (PT(1)); -- (2,7,2)
|
TB1.EB4 (PT(1)); -- (2,7,2)
|
PT(3) := PT(3) + 7; -- (2,7,9)
|
PT(3) := PT(3) + 7; -- (2,7,9)
|
IF (PT.ALL /= (2,7,9)) THEN
|
IF (PT.ALL /= (2,7,9)) THEN
|
FAILED ("ASSIGNMENT TO COMPONENT OF " &
|
FAILED ("ASSIGNMENT TO COMPONENT OF " &
|
"ARRAY ACCESS PARAMETER FAILED");
|
"ARRAY ACCESS PARAMETER FAILED");
|
END IF;
|
END IF;
|
END;
|
END;
|
END EB;
|
END EB;
|
END TB;
|
END TB;
|
|
|
BEGIN -- (B)
|
BEGIN -- (B)
|
|
|
PT := NEW TBL'(0,0,0);
|
PT := NEW TBL'(0,0,0);
|
TB.EB (PT);
|
TB.EB (PT);
|
|
|
END; -- (B)
|
END; -- (B)
|
|
|
---------------------------------------------
|
---------------------------------------------
|
|
|
DECLARE -- (C)
|
DECLARE -- (C)
|
|
|
TYPE REC IS
|
TYPE REC IS
|
RECORD
|
RECORD
|
I1 : INTEGER;
|
I1 : INTEGER;
|
I2 : INTEGER;
|
I2 : INTEGER;
|
I3 : INTEGER;
|
I3 : INTEGER;
|
END RECORD;
|
END RECORD;
|
|
|
TYPE PTRREC IS ACCESS REC;
|
TYPE PTRREC IS ACCESS REC;
|
PR : PTRREC;
|
PR : PTRREC;
|
|
|
TASK TC IS
|
TASK TC IS
|
ENTRY EC (PR : IN PTRREC);
|
ENTRY EC (PR : IN PTRREC);
|
END TC;
|
END TC;
|
|
|
TASK BODY TC IS
|
TASK BODY TC IS
|
BEGIN
|
BEGIN
|
ACCEPT EC (PR : IN PTRREC) DO
|
ACCEPT EC (PR : IN PTRREC) DO
|
DECLARE
|
DECLARE
|
TASK TC1 IS
|
TASK TC1 IS
|
ENTRY EC1 (R : OUT REC);
|
ENTRY EC1 (R : OUT REC);
|
ENTRY EC2 (R : IN OUT REC);
|
ENTRY EC2 (R : IN OUT REC);
|
ENTRY EC3 (I : OUT INTEGER);
|
ENTRY EC3 (I : OUT INTEGER);
|
ENTRY EC4 (I : IN OUT INTEGER);
|
ENTRY EC4 (I : IN OUT INTEGER);
|
END TC1;
|
END TC1;
|
|
|
TASK BODY TC1 IS
|
TASK BODY TC1 IS
|
BEGIN
|
BEGIN
|
ACCEPT EC1 (R : OUT REC) DO
|
ACCEPT EC1 (R : OUT REC) DO
|
R := (1,2,3);
|
R := (1,2,3);
|
END EC1;
|
END EC1;
|
|
|
ACCEPT EC2 (R : IN OUT REC) DO
|
ACCEPT EC2 (R : IN OUT REC) DO
|
R.I3 := R.I3 - 1;
|
R.I3 := R.I3 - 1;
|
END EC2;
|
END EC2;
|
|
|
ACCEPT EC3 (I : OUT INTEGER) DO
|
ACCEPT EC3 (I : OUT INTEGER) DO
|
I := 7;
|
I := 7;
|
END EC3;
|
END EC3;
|
|
|
ACCEPT EC4 (I : IN OUT INTEGER) DO
|
ACCEPT EC4 (I : IN OUT INTEGER) DO
|
I := I + 1;
|
I := I + 1;
|
END EC4;
|
END EC4;
|
END TC1;
|
END TC1;
|
|
|
BEGIN
|
BEGIN
|
TC1.EC1 (PR.ALL); -- (1,2,3)
|
TC1.EC1 (PR.ALL); -- (1,2,3)
|
TC1.EC2 (PR.ALL); -- (1,2,2)
|
TC1.EC2 (PR.ALL); -- (1,2,2)
|
TC1.EC3 (PR.I2); -- (1,7,2)
|
TC1.EC3 (PR.I2); -- (1,7,2)
|
TC1.EC4 (PR.I1); -- (2,7,2)
|
TC1.EC4 (PR.I1); -- (2,7,2)
|
PR.I3 := PR.I3 + 7; -- (2,7,9)
|
PR.I3 := PR.I3 + 7; -- (2,7,9)
|
IF (PR.ALL /= (2,7,9)) THEN
|
IF (PR.ALL /= (2,7,9)) THEN
|
FAILED ("ASSIGNMENT TO COMPONENT OF " &
|
FAILED ("ASSIGNMENT TO COMPONENT OF " &
|
"RECORD ACCESS PARAMETER " &
|
"RECORD ACCESS PARAMETER " &
|
"FAILED");
|
"FAILED");
|
END IF;
|
END IF;
|
END;
|
END;
|
END EC;
|
END EC;
|
END TC;
|
END TC;
|
|
|
BEGIN -- (C)
|
BEGIN -- (C)
|
|
|
PR := NEW REC'(0,0,0);
|
PR := NEW REC'(0,0,0);
|
TC.EC (PR);
|
TC.EC (PR);
|
|
|
END; -- (C)
|
END; -- (C)
|
|
|
---------------------------------------------
|
---------------------------------------------
|
|
|
RESULT;
|
RESULT;
|
|
|
END C95071A;
|
END C95071A;
|
|
|