-- C61010A.ADA
|
-- C61010A.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 AN IN OR IN OUT FORMAL PARAMETER CAN BE DECLARED WITH A
|
-- CHECK THAT AN IN OR IN OUT FORMAL PARAMETER CAN BE DECLARED WITH A
|
-- LIMITED PRIVATE TYPE OR A LIMITED COMPOSITE TYPE.
|
-- LIMITED PRIVATE TYPE OR A LIMITED COMPOSITE TYPE.
|
|
|
-- DAS 1/22/81
|
-- DAS 1/22/81
|
-- JRK 1/20/84 TOTALLY REVISED.
|
-- JRK 1/20/84 TOTALLY REVISED.
|
|
|
WITH REPORT; USE REPORT;
|
WITH REPORT; USE REPORT;
|
PROCEDURE C61010A IS
|
PROCEDURE C61010A IS
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
|
|
TYPE ITYPE IS LIMITED PRIVATE;
|
TYPE ITYPE IS LIMITED PRIVATE;
|
|
|
PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
|
PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
|
|
|
PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
|
PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
|
M : STRING);
|
M : STRING);
|
|
|
PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER);
|
PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER);
|
|
|
SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
|
SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
|
TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
|
TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
|
|
|
PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
|
PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
|
S : STRING; M : STRING);
|
S : STRING; M : STRING);
|
|
|
PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
|
PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
|
I : INTEGER; S : STRING;
|
I : INTEGER; S : STRING;
|
M : STRING);
|
M : STRING);
|
|
|
PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
|
PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
|
S : STRING);
|
S : STRING);
|
|
|
PRIVATE
|
PRIVATE
|
|
|
TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
|
TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
|
|
|
TYPE VRTYPE (C : INT_0_20 := 20) IS
|
TYPE VRTYPE (C : INT_0_20 := 20) IS
|
RECORD
|
RECORD
|
I : INTEGER;
|
I : INTEGER;
|
S : STRING (1 .. C);
|
S : STRING (1 .. C);
|
END RECORD;
|
END RECORD;
|
|
|
END PKG;
|
END PKG;
|
|
|
USE PKG;
|
USE PKG;
|
|
|
I1 : ITYPE;
|
I1 : ITYPE;
|
|
|
TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
|
TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
|
|
|
A1 : ATYPE;
|
A1 : ATYPE;
|
|
|
VR1 : VRTYPE;
|
VR1 : VRTYPE;
|
|
|
D : CONSTANT INT_0_20 := 10;
|
D : CONSTANT INT_0_20 := 10;
|
|
|
TYPE RTYPE IS
|
TYPE RTYPE IS
|
RECORD
|
RECORD
|
J : ITYPE;
|
J : ITYPE;
|
R : VRTYPE (D);
|
R : VRTYPE (D);
|
END RECORD;
|
END RECORD;
|
|
|
R1 : RTYPE;
|
R1 : RTYPE;
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
|
|
PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
|
PROCEDURE LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
|
BEGIN
|
BEGIN
|
IF INTEGER (X) /= V THEN
|
IF INTEGER (X) /= V THEN
|
FAILED ("WRONG SCALAR VALUE - " & M);
|
FAILED ("WRONG SCALAR VALUE - " & M);
|
END IF;
|
END IF;
|
END LOOK_IN_I;
|
END LOOK_IN_I;
|
|
|
PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
|
PROCEDURE LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
|
M : STRING) IS
|
M : STRING) IS
|
BEGIN
|
BEGIN
|
IF INTEGER (X) /= V THEN
|
IF INTEGER (X) /= V THEN
|
FAILED ("WRONG SCALAR VALUE - " & M);
|
FAILED ("WRONG SCALAR VALUE - " & M);
|
END IF;
|
END IF;
|
END LOOK_INOUT_I;
|
END LOOK_INOUT_I;
|
|
|
PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER) IS
|
PROCEDURE SET_I (X : IN OUT ITYPE; V : INTEGER) IS
|
BEGIN
|
BEGIN
|
X := ITYPE (IDENT_INT (V));
|
X := ITYPE (IDENT_INT (V));
|
END SET_I;
|
END SET_I;
|
|
|
PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
|
PROCEDURE LOOK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
|
S : STRING; M : STRING) IS
|
S : STRING; M : STRING) IS
|
BEGIN
|
BEGIN
|
IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
|
IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
|
FAILED ("WRONG COMPOSITE VALUE - " & M);
|
FAILED ("WRONG COMPOSITE VALUE - " & M);
|
END IF;
|
END IF;
|
END LOOK_IN_VR;
|
END LOOK_IN_VR;
|
|
|
PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
|
PROCEDURE LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
|
I : INTEGER; S : STRING;
|
I : INTEGER; S : STRING;
|
M : STRING) IS
|
M : STRING) IS
|
BEGIN
|
BEGIN
|
IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
|
IF (X.C /= C OR X.I /= I) OR ELSE X.S /= S THEN
|
FAILED ("WRONG COMPOSITE VALUE - " & M);
|
FAILED ("WRONG COMPOSITE VALUE - " & M);
|
END IF;
|
END IF;
|
END LOOK_INOUT_VR;
|
END LOOK_INOUT_VR;
|
|
|
PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
|
PROCEDURE SET_VR (X : IN OUT VRTYPE; C : INTEGER; I : INTEGER;
|
S : STRING) IS
|
S : STRING) IS
|
BEGIN
|
BEGIN
|
X := (IDENT_INT(C), IDENT_INT(I), IDENT_STR(S));
|
X := (IDENT_INT(C), IDENT_INT(I), IDENT_STR(S));
|
END SET_VR;
|
END SET_VR;
|
|
|
BEGIN
|
BEGIN
|
I1 := ITYPE (IDENT_INT(2));
|
I1 := ITYPE (IDENT_INT(2));
|
|
|
FOR I IN A1'RANGE LOOP
|
FOR I IN A1'RANGE LOOP
|
A1 (I) := ITYPE (3 + IDENT_INT(I));
|
A1 (I) := ITYPE (3 + IDENT_INT(I));
|
END LOOP;
|
END LOOP;
|
|
|
VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
|
VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
|
|
|
R1.J := ITYPE (IDENT_INT(6));
|
R1.J := ITYPE (IDENT_INT(6));
|
R1.R := (IDENT_INT(D), IDENT_INT(19),
|
R1.R := (IDENT_INT(D), IDENT_INT(19),
|
IDENT_STR("ABCDEFGHIJ"));
|
IDENT_STR("ABCDEFGHIJ"));
|
END PKG;
|
END PKG;
|
|
|
PROCEDURE CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
|
PROCEDURE CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) IS
|
BEGIN
|
BEGIN
|
LOOK_IN_I (X, V, M);
|
LOOK_IN_I (X, V, M);
|
END CHECK_IN_I;
|
END CHECK_IN_I;
|
|
|
PROCEDURE CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
|
PROCEDURE CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
|
NV : INTEGER; M : STRING) IS
|
NV : INTEGER; M : STRING) IS
|
BEGIN
|
BEGIN
|
LOOK_INOUT_I (X, OV, M & " - A");
|
LOOK_INOUT_I (X, OV, M & " - A");
|
SET_I (X, NV);
|
SET_I (X, NV);
|
LOOK_INOUT_I (X, NV, M & " - B");
|
LOOK_INOUT_I (X, NV, M & " - B");
|
LOOK_IN_I (X, NV, M & " - C");
|
LOOK_IN_I (X, NV, M & " - C");
|
END CHECK_INOUT_I;
|
END CHECK_INOUT_I;
|
|
|
PROCEDURE CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) IS
|
PROCEDURE CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) IS
|
BEGIN
|
BEGIN
|
FOR I IN X'RANGE LOOP
|
FOR I IN X'RANGE LOOP
|
LOOK_IN_I (X(I), V+I, M & " -" & INTEGER'IMAGE (I));
|
LOOK_IN_I (X(I), V+I, M & " -" & INTEGER'IMAGE (I));
|
END LOOP;
|
END LOOP;
|
END CHECK_IN_A;
|
END CHECK_IN_A;
|
|
|
PROCEDURE CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
|
PROCEDURE CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
|
NV : INTEGER; M : STRING) IS
|
NV : INTEGER; M : STRING) IS
|
BEGIN
|
BEGIN
|
FOR I IN X'RANGE LOOP
|
FOR I IN X'RANGE LOOP
|
LOOK_INOUT_I (X(I), OV+I, M & " - A" &
|
LOOK_INOUT_I (X(I), OV+I, M & " - A" &
|
INTEGER'IMAGE (I));
|
INTEGER'IMAGE (I));
|
SET_I (X(I), NV+I);
|
SET_I (X(I), NV+I);
|
LOOK_INOUT_I (X(I), NV+I, M & " - B" &
|
LOOK_INOUT_I (X(I), NV+I, M & " - B" &
|
INTEGER'IMAGE (I));
|
INTEGER'IMAGE (I));
|
LOOK_IN_I (X(I), NV+I, M & " - C" & INTEGER'IMAGE (I));
|
LOOK_IN_I (X(I), NV+I, M & " - C" & INTEGER'IMAGE (I));
|
END LOOP;
|
END LOOP;
|
END CHECK_INOUT_A;
|
END CHECK_INOUT_A;
|
|
|
PROCEDURE CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
|
PROCEDURE CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
|
S : STRING; M : STRING) IS
|
S : STRING; M : STRING) IS
|
BEGIN
|
BEGIN
|
LOOK_IN_VR (X, C, I, S, M);
|
LOOK_IN_VR (X, C, I, S, M);
|
END CHECK_IN_VR;
|
END CHECK_IN_VR;
|
|
|
PROCEDURE CHECK_INOUT_VR (X : IN OUT VRTYPE;
|
PROCEDURE CHECK_INOUT_VR (X : IN OUT VRTYPE;
|
OC : INTEGER; OI : INTEGER; OS : STRING;
|
OC : INTEGER; OI : INTEGER; OS : STRING;
|
NC : INTEGER; NI : INTEGER; NS : STRING;
|
NC : INTEGER; NI : INTEGER; NS : STRING;
|
M : STRING) IS
|
M : STRING) IS
|
BEGIN
|
BEGIN
|
LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
|
LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
|
SET_VR (X, NC, NI, NS);
|
SET_VR (X, NC, NI, NS);
|
LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
|
LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
|
LOOK_IN_VR (X, NC, NI, NS, M & " - C");
|
LOOK_IN_VR (X, NC, NI, NS, M & " - C");
|
END CHECK_INOUT_VR;
|
END CHECK_INOUT_VR;
|
|
|
PROCEDURE CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
|
PROCEDURE CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
|
I : INTEGER; S : STRING; M : STRING) IS
|
I : INTEGER; S : STRING; M : STRING) IS
|
BEGIN
|
BEGIN
|
LOOK_IN_I (X.J, J, M & " - A");
|
LOOK_IN_I (X.J, J, M & " - A");
|
LOOK_IN_VR (X.R, C, I, S, M & " - B");
|
LOOK_IN_VR (X.R, C, I, S, M & " - B");
|
END CHECK_IN_R;
|
END CHECK_IN_R;
|
|
|
PROCEDURE CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
|
PROCEDURE CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
|
OC : INTEGER; OI : INTEGER; OS : STRING;
|
OC : INTEGER; OI : INTEGER; OS : STRING;
|
NJ : INTEGER;
|
NJ : INTEGER;
|
NC : INTEGER; NI : INTEGER; NS : STRING;
|
NC : INTEGER; NI : INTEGER; NS : STRING;
|
M : STRING) IS
|
M : STRING) IS
|
BEGIN
|
BEGIN
|
LOOK_INOUT_I (X.J, OJ, M & " - A");
|
LOOK_INOUT_I (X.J, OJ, M & " - A");
|
LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
|
LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
|
SET_I (X.J, NJ);
|
SET_I (X.J, NJ);
|
SET_VR (X.R, NC, NI, NS);
|
SET_VR (X.R, NC, NI, NS);
|
LOOK_INOUT_I (X.J, NJ, M & " - C");
|
LOOK_INOUT_I (X.J, NJ, M & " - C");
|
LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
|
LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
|
LOOK_IN_I (X.J, NJ, M & " - E");
|
LOOK_IN_I (X.J, NJ, M & " - E");
|
LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
|
LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
|
END CHECK_INOUT_R;
|
END CHECK_INOUT_R;
|
|
|
BEGIN
|
BEGIN
|
TEST ("C61010A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
|
TEST ("C61010A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
|
"CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
|
"CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
|
|
|
CHECK_IN_I (I1, 2, "IN I");
|
CHECK_IN_I (I1, 2, "IN I");
|
|
|
CHECK_INOUT_I (I1, 2, 5, "INOUT I");
|
CHECK_INOUT_I (I1, 2, 5, "INOUT I");
|
|
|
CHECK_IN_A (A1, 3, "IN A");
|
CHECK_IN_A (A1, 3, "IN A");
|
|
|
CHECK_INOUT_A (A1, 3, 17, "INOUT A");
|
CHECK_INOUT_A (A1, 3, 17, "INOUT A");
|
|
|
CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
|
CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
|
|
|
CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
|
CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
|
"INOUT VR");
|
"INOUT VR");
|
|
|
CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
|
CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
|
|
|
CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, "ZYXWVUTSRQ",
|
CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5, "ZYXWVUTSRQ",
|
"INOUT R");
|
"INOUT R");
|
|
|
RESULT;
|
RESULT;
|
END C61010A;
|
END C61010A;
|
|
|