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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
26 -- UNCONSTRAINED FORMAL PARAMETERS.
28 -- ATTRIBUTES OF SLICE OF SLICE
32 -- JWC 6/28/85 RENAMED TO -AB
39 TYPE I_A
IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
40 TYPE I_A_2
IS ARRAY (INTEGER RANGE <> ,
41 INTEGER RANGE <> ) OF INTEGER;
44 I10
: INTEGER := IDENT_INT
(10);
45 A2_10
: I_A_2
(1 .. I10
, 3+I10
.. I10
+I10
); -- 1..10, 13..20
46 A2_20
: I_A_2
(11 .. 3*I10
, I10
+11 .. I10
+I10
); -- 11..30, 21..20
47 TYPE STR
IS NEW STRING;
48 ALF
: CONSTANT STR
:= STR
(IDENT_STR
("ABCDE"));
49 ARF
: STR
(5 .. 9) := ALF
;
51 PROCEDURE P1
(A
: I_A
; FIR
, LAS
: INTEGER; S
: STRING) IS
56 FAILED
("'FIRST IS WRONG " & S
);
62 FAILED
("'LAST IS WRONG " & S
);
65 IF A
'LENGTH /= LAS
- FIR
+ 1
66 OR A
'LENGTH /= A
'LENGTH(1)
68 FAILED
("'LENGTH IS WRONG " & S
);
71 IF (LAS
NOT IN A
'RANGE AND LAS
>= FIR
)
72 OR (FIR
NOT IN A
'RANGE AND LAS
>= FIR
)
74 OR LAS
+ 1 IN A
'RANGE(1)
76 FAILED
("'RANGE IS WRONG " & S
);
81 PROCEDURE P2
(A
: I_A_2
; F1
,L1
,F2
,L2
: INTEGER; S
: STRING) IS
83 IF A
'FIRST /= A
'FIRST(1)
86 FAILED
("'FIRST(1) IS WRONG " & S
);
89 IF A
'LAST(1) /= L1
THEN
90 FAILED
("'LAST(1) IS WRONG " & S
);
93 IF A
'LENGTH(1) /= A
'LENGTH
94 OR A
'LENGTH /= L1
- F1
+ 1
96 FAILED
("'LENGTH(1) IS WRONG " & S
);
100 OR (F1
NOT IN A
'RANGE AND F1
<= L1
)
101 OR (L1
NOT IN A
'RANGE(1) AND F1
<= L1
)
102 OR L1
+ 1 IN A
'RANGE(1)
104 FAILED
("'RANGE(1) IS WRONG " & S
);
107 IF A
'FIRST(2) /= F2
THEN
108 FAILED
("'FIRST(2) IS WRONG " & S
);
111 IF A
'LAST(2) /= L2
THEN
112 FAILED
("'LAST(2) IS WRONG " & S
);
115 IF L2
- F2
/= A
'LENGTH(2) - 1 THEN
116 FAILED
("'LENGTH(2) IS WRONG " & S
);
119 IF F2
- 1 IN A
'RANGE(2)
120 OR (F2
NOT IN A
'RANGE(2) AND A
'LENGTH(2) > 0)
121 OR (L2
NOT IN A
'RANGE(2) AND A
'LENGTH(2) /= 0)
122 OR L2
+ 1 IN A
'RANGE(2)
124 FAILED
("'RANGE(2) IS WRONG " & S
);
128 PROCEDURE S1
(S
:STR
; F
,L
:INTEGER; MESS
:STRING) IS
131 FAILED
("STRING 'FIRST IS WRONG " & MESS
);
134 IF S
'LAST(1) /= L
THEN
135 FAILED
("STRING 'LAST IS WRONG " & MESS
);
138 IF S
'LENGTH /= L
- F
+ 1
139 OR S
'LENGTH(1) /= S
'LENGTH
141 FAILED
("STRING 'LENGTH IS WRONG " & MESS
);
147 OR F
NOT IN S
'RANGE(1)
148 OR L
NOT IN S
'RANGE(1)))
150 OR L
+ 1 IN S
'RANGE(1)
152 FAILED
("STRING 'RANGE IS WRONG " & MESS
);
157 TEST
( "C36205K", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
158 "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
159 "ARRAYS - SLICES OF SLICES");
161 FOR I
IN 18 .. 20 LOOP
162 FOR J
IN I
-1 .. 20 LOOP
163 P1
(A20
(A20
'RANGE)(I
..J
), I
, J
, "A20 99");
167 FOR J
IN I
- 1 .. 5 LOOP
168 S1
(ALF
(1..5)(I
..J
),I
,J
,"ALF 3");