-- C64106A.ADA
|
-- C64106A.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 UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
|
-- CHECK THAT UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
|
-- FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
|
-- FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
|
-- SUBTESTS ARE:
|
-- SUBTESTS ARE:
|
-- (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
|
-- (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
|
-- (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
|
-- (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
|
-- (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
|
-- (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
|
-- (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
|
-- (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
|
|
|
-- DAS 1/15/81
|
-- DAS 1/15/81
|
-- JBG 5/16/83
|
-- JBG 5/16/83
|
-- CPP 5/22/84
|
-- CPP 5/22/84
|
|
|
WITH REPORT;
|
WITH REPORT;
|
PROCEDURE C64106A IS
|
PROCEDURE C64106A IS
|
|
|
USE REPORT;
|
USE REPORT;
|
|
|
BEGIN
|
BEGIN
|
TEST ("C64106A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
|
TEST ("C64106A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
|
"UNCONSTRAINED FORMAL PARAMETERS");
|
"UNCONSTRAINED FORMAL PARAMETERS");
|
|
|
DECLARE -- (A)
|
DECLARE -- (A)
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
|
|
SUBTYPE INT IS INTEGER RANGE 0..100;
|
SUBTYPE INT IS INTEGER RANGE 0..100;
|
|
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
RECORD
|
RECORD
|
INTFIELD : INTEGER;
|
INTFIELD : INTEGER;
|
STRFIELD : STRING (1..CONSTRAINT);
|
STRFIELD : STRING (1..CONSTRAINT);
|
END RECORD;
|
END RECORD;
|
|
|
REC1 : RECTYPE := (10,10,"0123456789");
|
REC1 : RECTYPE := (10,10,"0123456789");
|
REC2 : RECTYPE := (17,7,"C64106A..........");
|
REC2 : RECTYPE := (17,7,"C64106A..........");
|
REC3 : RECTYPE := (1,1,"A");
|
REC3 : RECTYPE := (1,1,"A");
|
REC4 : RECTYPE; -- 80
|
REC4 : RECTYPE; -- 80
|
|
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
|
REC2 : OUT RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC3 : IN OUT RECTYPE);
|
REC3 : IN OUT RECTYPE);
|
|
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
|
END PKG;
|
END PKG;
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
|
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE := (2,0,"AB");
|
REC2 : OUT RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC3 : IN OUT RECTYPE) IS
|
REC3 : IN OUT RECTYPE) IS
|
BEGIN
|
BEGIN
|
IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
|
IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
|
FAILED ("RECORD TYPE IN PARAMETER DID " &
|
FAILED ("RECORD TYPE IN PARAMETER DID " &
|
"NOT USE CONSTRAINT OF ACTUAL");
|
"NOT USE CONSTRAINT OF ACTUAL");
|
END IF;
|
END IF;
|
IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
|
IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
|
FAILED ("RECORD TYPE OUT PARAMETER DID " &
|
FAILED ("RECORD TYPE OUT PARAMETER DID " &
|
"NOT USE CONSTRAINT OF ACTUAL");
|
"NOT USE CONSTRAINT OF ACTUAL");
|
END IF;
|
END IF;
|
IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
|
IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
|
FAILED ("RECORD TYPE IN OUT PARAMETER DID " &
|
FAILED ("RECORD TYPE IN OUT PARAMETER DID " &
|
"NOT USE CONSTRAINT OF ACTUAL");
|
"NOT USE CONSTRAINT OF ACTUAL");
|
END IF;
|
END IF;
|
REC2 := PKG.REC2;
|
REC2 := PKG.REC2;
|
END CHK_RECTYPE1;
|
END CHK_RECTYPE1;
|
|
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
|
BEGIN
|
BEGIN
|
IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
|
IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
|
FAILED ("RECORD TYPE OUT PARAMETER DID " &
|
FAILED ("RECORD TYPE OUT PARAMETER DID " &
|
"NOT USE CONSTRAINT OF " &
|
"NOT USE CONSTRAINT OF " &
|
"UNINITIALIZED ACTUAL");
|
"UNINITIALIZED ACTUAL");
|
END IF;
|
END IF;
|
REC := (10,10,"9876543210");
|
REC := (10,10,"9876543210");
|
END CHK_RECTYPE2;
|
END CHK_RECTYPE2;
|
END PKG;
|
END PKG;
|
|
|
BEGIN -- (A)
|
BEGIN -- (A)
|
|
|
PKG.CHK_RECTYPE1 (PKG.REC1, PKG.REC2, PKG.REC3);
|
PKG.CHK_RECTYPE1 (PKG.REC1, PKG.REC2, PKG.REC3);
|
PKG.CHK_RECTYPE2 (PKG.REC4);
|
PKG.CHK_RECTYPE2 (PKG.REC4);
|
|
|
END; -- (A)
|
END; -- (A)
|
|
|
---------------------------------------------
|
---------------------------------------------
|
|
|
B : DECLARE -- (B)
|
B : DECLARE -- (B)
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
|
|
SUBTYPE INT IS INTEGER RANGE 0..100;
|
SUBTYPE INT IS INTEGER RANGE 0..100;
|
|
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
|
|
|
|
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC3 : IN OUT RECTYPE);
|
REC3 : IN OUT RECTYPE);
|
|
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
|
|
|
PRIVATE
|
PRIVATE
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
RECORD
|
RECORD
|
INTFIELD : INTEGER;
|
INTFIELD : INTEGER;
|
STRFIELD : STRING (1..CONSTRAINT);
|
STRFIELD : STRING (1..CONSTRAINT);
|
END RECORD;
|
END RECORD;
|
END PKG;
|
END PKG;
|
|
|
REC1 : PKG.RECTYPE(10);
|
REC1 : PKG.RECTYPE(10);
|
REC2 : PKG.RECTYPE(17);
|
REC2 : PKG.RECTYPE(17);
|
REC3 : PKG.RECTYPE(1);
|
REC3 : PKG.RECTYPE(1);
|
REC4 : PKG.RECTYPE(10);
|
REC4 : PKG.RECTYPE(10);
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
|
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC3 : IN OUT RECTYPE) IS
|
REC3 : IN OUT RECTYPE) IS
|
BEGIN
|
BEGIN
|
IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
|
IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
|
FAILED ("PRIVATE TYPE IN PARAMETER DID " &
|
FAILED ("PRIVATE TYPE IN PARAMETER DID " &
|
"NOT USE CONSTRAINT OF ACTUAL");
|
"NOT USE CONSTRAINT OF ACTUAL");
|
END IF;
|
END IF;
|
IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
|
IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
|
FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
|
FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
|
"NOT USE CONSTRAINT OF ACTUAL");
|
"NOT USE CONSTRAINT OF ACTUAL");
|
END IF;
|
END IF;
|
IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
|
IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
|
FAILED ("PRIVATE TYPE IN OUT PARAMETER DID " &
|
FAILED ("PRIVATE TYPE IN OUT PARAMETER DID " &
|
"NOT USE CONSTRAINT OF ACTUAL");
|
"NOT USE CONSTRAINT OF ACTUAL");
|
END IF;
|
END IF;
|
REC2 := B.REC2;
|
REC2 := B.REC2;
|
END CHK_RECTYPE1;
|
END CHK_RECTYPE1;
|
|
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
|
BEGIN
|
BEGIN
|
IF (REC.CONSTRAINT /= IDENT_INT(10)) THEN
|
IF (REC.CONSTRAINT /= IDENT_INT(10)) THEN
|
FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
|
FAILED ("PRIVATE TYPE OUT PARAMETER DID " &
|
"NOT USE CONSTRAINT OF " &
|
"NOT USE CONSTRAINT OF " &
|
"UNINITIALIZED ACTUAL");
|
"UNINITIALIZED ACTUAL");
|
END IF;
|
END IF;
|
REC := (10,10,"9876543210");
|
REC := (10,10,"9876543210");
|
END CHK_RECTYPE2;
|
END CHK_RECTYPE2;
|
|
|
BEGIN
|
BEGIN
|
REC1 := (10,10,"0123456789");
|
REC1 := (10,10,"0123456789");
|
REC2 := (17,7,"C64106A..........");
|
REC2 := (17,7,"C64106A..........");
|
REC3 := (1,1,"A");
|
REC3 := (1,1,"A");
|
|
|
END PKG;
|
END PKG;
|
|
|
BEGIN -- (B)
|
BEGIN -- (B)
|
|
|
PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
|
PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
|
PKG.CHK_RECTYPE2 (REC4);
|
PKG.CHK_RECTYPE2 (REC4);
|
|
|
END B; -- (B)
|
END B; -- (B)
|
|
|
---------------------------------------------
|
---------------------------------------------
|
|
|
C : DECLARE -- (C)
|
C : DECLARE -- (C)
|
|
|
PACKAGE PKG IS
|
PACKAGE PKG IS
|
|
|
SUBTYPE INT IS INTEGER RANGE 0..100;
|
SUBTYPE INT IS INTEGER RANGE 0..100;
|
|
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
LIMITED PRIVATE;
|
LIMITED PRIVATE;
|
|
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC3 : IN OUT RECTYPE);
|
REC3 : IN OUT RECTYPE);
|
|
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE);
|
|
|
PRIVATE
|
PRIVATE
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
TYPE RECTYPE (CONSTRAINT : INT := 80) IS
|
RECORD
|
RECORD
|
INTFIELD : INTEGER;
|
INTFIELD : INTEGER;
|
STRFIELD : STRING (1..CONSTRAINT);
|
STRFIELD : STRING (1..CONSTRAINT);
|
END RECORD;
|
END RECORD;
|
END PKG;
|
END PKG;
|
|
|
REC1 : PKG.RECTYPE; -- 10
|
REC1 : PKG.RECTYPE; -- 10
|
REC2 : PKG.RECTYPE; -- 17
|
REC2 : PKG.RECTYPE; -- 17
|
REC3 : PKG.RECTYPE; -- 1
|
REC3 : PKG.RECTYPE; -- 1
|
REC4 : PKG.RECTYPE; -- 80
|
REC4 : PKG.RECTYPE; -- 80
|
|
|
PACKAGE BODY PKG IS
|
PACKAGE BODY PKG IS
|
|
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
PROCEDURE CHK_RECTYPE1 (REC1 : IN RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC2 : OUT RECTYPE;
|
REC3 : IN OUT RECTYPE) IS
|
REC3 : IN OUT RECTYPE) IS
|
BEGIN
|
BEGIN
|
IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
|
IF (REC1.CONSTRAINT /= IDENT_INT(10)) THEN
|
FAILED ("LIMITED PRIVATE TYPE IN PARAMETER " &
|
FAILED ("LIMITED PRIVATE TYPE IN PARAMETER " &
|
"DID NOT USE CONSTRAINT OF " &
|
"DID NOT USE CONSTRAINT OF " &
|
"ACTUAL");
|
"ACTUAL");
|
END IF;
|
END IF;
|
IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
|
IF (REC2.CONSTRAINT /= IDENT_INT(17)) THEN
|
FAILED ("LIMITED PRIVATE TYPE OUT PARAMETER " &
|
FAILED ("LIMITED PRIVATE TYPE OUT PARAMETER " &
|
"DID NOT USE CONSTRAINT OF " &
|
"DID NOT USE CONSTRAINT OF " &
|
"ACTUAL");
|
"ACTUAL");
|
END IF;
|
END IF;
|
IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
|
IF (REC3.CONSTRAINT /= IDENT_INT(1)) THEN
|
FAILED ("LIMITED PRIVATE TYPE IN OUT " &
|
FAILED ("LIMITED PRIVATE TYPE IN OUT " &
|
"PARAMETER DID NOT USE " &
|
"PARAMETER DID NOT USE " &
|
"CONSTRAINT OF ACTUAL");
|
"CONSTRAINT OF ACTUAL");
|
END IF;
|
END IF;
|
REC2 := C.REC2;
|
REC2 := C.REC2;
|
END CHK_RECTYPE1;
|
END CHK_RECTYPE1;
|
|
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
|
PROCEDURE CHK_RECTYPE2 (REC : OUT RECTYPE) IS
|
BEGIN
|
BEGIN
|
IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
|
IF (REC.CONSTRAINT /= IDENT_INT(80)) THEN
|
FAILED ("LIMITED PRIVATE TYPE OUT " &
|
FAILED ("LIMITED PRIVATE TYPE OUT " &
|
"PARAMETER DID NOT USE " &
|
"PARAMETER DID NOT USE " &
|
"CONSTRAINT OF UNINITIALIZED ACTUAL");
|
"CONSTRAINT OF UNINITIALIZED ACTUAL");
|
END IF;
|
END IF;
|
REC := (10,10,"9876543210");
|
REC := (10,10,"9876543210");
|
END CHK_RECTYPE2;
|
END CHK_RECTYPE2;
|
|
|
BEGIN
|
BEGIN
|
REC1 := (10,10,"0123456789");
|
REC1 := (10,10,"0123456789");
|
REC2 := (17,7,"C64106A..........");
|
REC2 := (17,7,"C64106A..........");
|
REC3 := (1,1,"A");
|
REC3 := (1,1,"A");
|
END PKG;
|
END PKG;
|
|
|
BEGIN -- (C)
|
BEGIN -- (C)
|
|
|
PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
|
PKG.CHK_RECTYPE1 (REC1, REC2, REC3);
|
PKG.CHK_RECTYPE2 (REC4);
|
PKG.CHK_RECTYPE2 (REC4);
|
|
|
END C; -- (C)
|
END C; -- (C)
|
|
|
---------------------------------------------
|
---------------------------------------------
|
|
|
D : DECLARE -- (D)
|
D : DECLARE -- (D)
|
|
|
TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
|
TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
|
CHARACTER;
|
CHARACTER;
|
|
|
A1, A2, A3 : ATYPE(-1..1, 4..5) := (('A','B'),
|
A1, A2, A3 : ATYPE(-1..1, 4..5) := (('A','B'),
|
('C','D'),
|
('C','D'),
|
('E','F'));
|
('E','F'));
|
|
|
A4 : ATYPE(-1..1, 4..5);
|
A4 : ATYPE(-1..1, 4..5);
|
|
|
CA1 : CONSTANT ATYPE(8..9, -7..INTEGER'FIRST) :=
|
CA1 : CONSTANT ATYPE(8..9, -7..INTEGER'FIRST) :=
|
(8..9 => (-7..INTEGER'FIRST => 'A'));
|
(8..9 => (-7..INTEGER'FIRST => 'A'));
|
|
|
S1 : STRING(1..INTEGER'FIRST) := "";
|
S1 : STRING(1..INTEGER'FIRST) := "";
|
S2 : STRING(-5..-7) := "";
|
S2 : STRING(-5..-7) := "";
|
S3 : STRING(1..0) := "";
|
S3 : STRING(1..0) := "";
|
|
|
PROCEDURE CHK_ARRAY1 (A1 : IN ATYPE := CA1; A2 : OUT ATYPE;
|
PROCEDURE CHK_ARRAY1 (A1 : IN ATYPE := CA1; A2 : OUT ATYPE;
|
A3 : IN OUT ATYPE) IS
|
A3 : IN OUT ATYPE) IS
|
BEGIN
|
BEGIN
|
IF ((A1'FIRST(1) /= IDENT_INT(-1)) OR
|
IF ((A1'FIRST(1) /= IDENT_INT(-1)) OR
|
(A1'LAST(1) /= IDENT_INT(1)) OR
|
(A1'LAST(1) /= IDENT_INT(1)) OR
|
(A1'FIRST(2) /= IDENT_INT(4)) OR
|
(A1'FIRST(2) /= IDENT_INT(4)) OR
|
(A1'LAST(2) /= IDENT_INT(5))) THEN
|
(A1'LAST(2) /= IDENT_INT(5))) THEN
|
FAILED ("ARRAY TYPE IN PARAMETER DID NOT " &
|
FAILED ("ARRAY TYPE IN PARAMETER DID NOT " &
|
"USE CONSTRAINTS OF ACTUAL");
|
"USE CONSTRAINTS OF ACTUAL");
|
END IF;
|
END IF;
|
IF ((A2'FIRST(1) /= IDENT_INT(-1)) OR
|
IF ((A2'FIRST(1) /= IDENT_INT(-1)) OR
|
(A2'LAST(1) /= IDENT_INT(1)) OR
|
(A2'LAST(1) /= IDENT_INT(1)) OR
|
(A2'FIRST(2) /= IDENT_INT(4)) OR
|
(A2'FIRST(2) /= IDENT_INT(4)) OR
|
(A2'LAST(2) /= IDENT_INT(5))) THEN
|
(A2'LAST(2) /= IDENT_INT(5))) THEN
|
FAILED ("ARRAY TYPE OUT PARAMETER DID NOT USE" &
|
FAILED ("ARRAY TYPE OUT PARAMETER DID NOT USE" &
|
"CONSTRAINTS OF ACTUAL");
|
"CONSTRAINTS OF ACTUAL");
|
END IF;
|
END IF;
|
IF ((A3'FIRST(1) /= IDENT_INT(-1)) OR
|
IF ((A3'FIRST(1) /= IDENT_INT(-1)) OR
|
(A3'LAST(1) /= IDENT_INT(1)) OR
|
(A3'LAST(1) /= IDENT_INT(1)) OR
|
(A3'FIRST(2) /= IDENT_INT(4)) OR
|
(A3'FIRST(2) /= IDENT_INT(4)) OR
|
(A3'LAST(2) /= IDENT_INT(5))) THEN
|
(A3'LAST(2) /= IDENT_INT(5))) THEN
|
FAILED ("ARRAY TYPE IN OUT PARAMETER DID NOT " &
|
FAILED ("ARRAY TYPE IN OUT PARAMETER DID NOT " &
|
"USE CONSTRAINTS OF ACTUAL");
|
"USE CONSTRAINTS OF ACTUAL");
|
END IF;
|
END IF;
|
A2 := D.A2;
|
A2 := D.A2;
|
END CHK_ARRAY1;
|
END CHK_ARRAY1;
|
|
|
PROCEDURE CHK_ARRAY2 (A4 : OUT ATYPE) IS
|
PROCEDURE CHK_ARRAY2 (A4 : OUT ATYPE) IS
|
BEGIN
|
BEGIN
|
IF ((A4'FIRST(1) /= IDENT_INT(-1)) OR
|
IF ((A4'FIRST(1) /= IDENT_INT(-1)) OR
|
(A4'LAST(1) /= IDENT_INT(1)) OR
|
(A4'LAST(1) /= IDENT_INT(1)) OR
|
(A4'FIRST(2) /= IDENT_INT(4)) OR
|
(A4'FIRST(2) /= IDENT_INT(4)) OR
|
(A4'LAST(2) /= IDENT_INT(5))) THEN
|
(A4'LAST(2) /= IDENT_INT(5))) THEN
|
FAILED ("ARRAY TYPE OUT PARAMETER DID NOT " &
|
FAILED ("ARRAY TYPE OUT PARAMETER DID NOT " &
|
"USE CONSTRAINTS OF UNINITIALIZED " &
|
"USE CONSTRAINTS OF UNINITIALIZED " &
|
"ACTUAL");
|
"ACTUAL");
|
END IF;
|
END IF;
|
A4 := A2;
|
A4 := A2;
|
END CHK_ARRAY2;
|
END CHK_ARRAY2;
|
|
|
PROCEDURE CHK_STRING (S1 : IN STRING;
|
PROCEDURE CHK_STRING (S1 : IN STRING;
|
S2 : IN OUT STRING;
|
S2 : IN OUT STRING;
|
S3 : OUT STRING) IS
|
S3 : OUT STRING) IS
|
BEGIN
|
BEGIN
|
IF ((S1'FIRST /= IDENT_INT(1)) OR
|
IF ((S1'FIRST /= IDENT_INT(1)) OR
|
(S1'LAST /= IDENT_INT(INTEGER'FIRST))) THEN
|
(S1'LAST /= IDENT_INT(INTEGER'FIRST))) THEN
|
FAILED ("STRING TYPE IN PARAMETER DID NOT " &
|
FAILED ("STRING TYPE IN PARAMETER DID NOT " &
|
"USE CONSTRAINTS OF ACTUAL NULL " &
|
"USE CONSTRAINTS OF ACTUAL NULL " &
|
"STRING");
|
"STRING");
|
END IF;
|
END IF;
|
IF ((S2'FIRST /= IDENT_INT(-5)) OR
|
IF ((S2'FIRST /= IDENT_INT(-5)) OR
|
(S2'LAST /= IDENT_INT(-7))) THEN
|
(S2'LAST /= IDENT_INT(-7))) THEN
|
FAILED ("STRING TYPE IN OUT PARAMETER DID NOT " &
|
FAILED ("STRING TYPE IN OUT PARAMETER DID NOT " &
|
"USE CONSTRAINTS OF ACTUAL NULL STRING");
|
"USE CONSTRAINTS OF ACTUAL NULL STRING");
|
END IF;
|
END IF;
|
IF ((S3'FIRST /= IDENT_INT(1)) OR
|
IF ((S3'FIRST /= IDENT_INT(1)) OR
|
(S3'LAST /= IDENT_INT(0))) THEN
|
(S3'LAST /= IDENT_INT(0))) THEN
|
FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
|
FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
|
"USE CONSTRAINTS OF ACTUAL NULL STRING");
|
"USE CONSTRAINTS OF ACTUAL NULL STRING");
|
END IF;
|
END IF;
|
S3 := "";
|
S3 := "";
|
END CHK_STRING;
|
END CHK_STRING;
|
|
|
BEGIN -- (D)
|
BEGIN -- (D)
|
CHK_ARRAY1 (A1, A2, A3);
|
CHK_ARRAY1 (A1, A2, A3);
|
CHK_ARRAY2 (A4);
|
CHK_ARRAY2 (A4);
|
CHK_STRING (S1, S2, S3);
|
CHK_STRING (S1, S2, S3);
|
END D; -- (D)
|
END D; -- (D)
|
|
|
RESULT;
|
RESULT;
|
END C64106A;
|
END C64106A;
|
|
|