3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
25 -- CHECK THAT ARRAYS THAT ARE COMPONENTS OF RECORDS ARE PASSED CORRECTLY
26 -- TO SUBPROGRAMS. SPECIFICALLY,
27 -- (B) CHECK MULTIDIMENSIONAL ARRAYS.
31 WITH REPORT
; USE REPORT
;
35 TEST
("C64109B", "CHECK THAT ARRAYS WHICH ARE COMPONENTS OF " &
36 "RECORDS ARE PASSED CORRECTLY TO SUBPROGRAMS - " &
37 "MULTIDIMENSIONAL ARRAYS");
41 TYPE MULTI_TYPE
IS ARRAY (POSITIVE RANGE <>,
42 POSITIVE RANGE <>) OF BOOLEAN;
43 SUBTYPE MULTI_SUBTYPE
IS MULTI_TYPE
(1..2, 1..3);
51 A
=> (1..2 => (1..3 => IDENT_BOOL
(TRUE))));
54 PROCEDURE P1
(ARR
: MULTI_TYPE
) IS
56 IF ARR
/= (1..2 => (1..3 => TRUE)) THEN
57 FAILED
("IN PARAM NOT PASSED CORRECTLY");
60 IF ARR
'FIRST /= 1 OR ARR
'LAST /= IDENT_INT
(2) THEN
61 FAILED
("FIRST DIM NOT CORRECT - IN PARAMETER");
62 ELSIF ARR
'FIRST(2) /= IDENT_INT
(1) OR ARR
'LAST(2) /= 3
64 FAILED
("2ND DIM NOT CORRECT - IN PARAMETER");
68 FUNCTION F1
(ARR
: MULTI_TYPE
) RETURN BOOLEAN IS
70 IF ARR
/= (1..2 => (1..3 => TRUE)) THEN
71 FAILED
("IN PARAM NOT PASSED CORRECTLY TO FN");
74 IF ARR
'FIRST /= 1 OR ARR
'LAST /= IDENT_INT
(2) THEN
75 FAILED
("FIRST DIM NOT CORRECT - IN PARAMETER FN");
76 ELSIF ARR
'FIRST(2) /= IDENT_INT
(1) OR ARR
'LAST(2) /= 3
78 FAILED
("2ND DIM NOT CORRECT - IN PARAMETER FN");
83 PROCEDURE P2
(ARR
: IN OUT MULTI_TYPE
) IS
85 IF ARR
/= (1..2 => (1..3 => TRUE)) THEN
86 FAILED
("IN OUT PARAM NOT PASSED CORRECTLY");
89 IF ARR
'FIRST /= 1 OR ARR
'LAST /= IDENT_INT
(2) THEN
90 FAILED
("FIRST DIM NOT CORRECT - IN OUT PARAMETER");
91 ELSIF ARR
'FIRST(2) /= IDENT_INT
(1) OR ARR
'LAST(2) /= 3
93 FAILED
("2ND DIM NOT CORRECT - IN OUT PARAMETER");
95 ARR
:= (ARR
'RANGE(1) => (ARR
'RANGE(2) => FALSE));
98 PROCEDURE P3
(ARR
: OUT MULTI_TYPE
) IS
102 IF (J
MOD 2) = 0 THEN
110 IF ARR
'FIRST /= 1 OR ARR
'LAST /= IDENT_INT
(2) THEN
111 FAILED
("FIRST DIM NOT CORRECT - OUT PARAMETER");
112 ELSIF ARR
'FIRST(2) /= IDENT_INT
(1) OR ARR
'LAST(2) /= 3
114 FAILED
("2ND DIM NOT CORRECT - OUT PARAMETER");
121 IF REC
.A
/= (1..2 => (1..3 => TRUE)) THEN
122 FAILED
("IN PARAM CHANGED BY PROCEDURE");
126 IF REC
.A
/= (1..2 => (1..3 => TRUE)) THEN
127 FAILED
("IN PARAM CHANGED BY FUNCTION");
131 IF REC
.A
/= (1..2 => (1..3 => FALSE)) THEN
132 FAILED
("IN OUT PARAM CHANGED BY PROCEDURE");
138 IF (J
MOD 2) = 0 THEN
139 IF REC
.A
(I
, J
) /= TRUE THEN
140 FAILED
("OUT PARAM RETURNED " &
141 "INCORRECTLY - (B)");
144 IF REC
.A
(I
, J
) /= FALSE THEN
145 FAILED
("OUT PARAM RETURNED " &
146 "INCORRECTLY - (B)2");