1-- C36205C.ADA
2
3--                             Grant of Unlimited Rights
4--
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
14--     to do so.
15--
16--                                    DISCLAIMER
17--
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.
24--*
25-- CHECK THAT ATTRIBUTES GIVE THE CORRECT VALUES FOR
26-- UNCONSTRAINED FORMAL PARAMETERS.
27
28-- ATTRIBUTES OF NON-NULL DYNAMIC SLICES
29
30-- DAT 2/17/81
31-- JBG 9/11/81
32-- JWC 6/28/85   RENAMED TO -AB
33
34WITH REPORT;
35PROCEDURE C36205C IS
36
37     USE REPORT;
38
39     TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
40     TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
41          INTEGER RANGE <> ) OF INTEGER;
42     A10 : I_A (1 .. 10);
43     A20 : I_A (18 .. 20);
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     SUBTYPE STR IS STRING;
48     ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
49     ARF : STR(5 .. 9) := ALF;
50
51     PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
52     BEGIN
53          IF A'FIRST /= FIR
54             OR A'FIRST(1) /= FIR
55          THEN
56               FAILED ("'FIRST IS WRONG " & S);
57          END IF;
58
59          IF A'LAST /= LAS
60             OR A'LAST(1) /= LAS
61          THEN
62               FAILED ("'LAST IS WRONG " & S);
63          END IF;
64
65          IF A'LENGTH /= LAS - FIR + 1
66             OR A'LENGTH /= A'LENGTH(1)
67          THEN
68               FAILED ("'LENGTH IS WRONG " & S);
69          END IF;
70
71          IF (LAS NOT IN A'RANGE AND LAS >= FIR)
72             OR (FIR NOT IN A'RANGE AND LAS >= FIR)
73             OR FIR - 1 IN A'RANGE
74             OR LAS + 1 IN A'RANGE(1)
75          THEN
76               FAILED ("'RANGE IS WRONG " & S);
77          END IF;
78
79     END P1;
80
81     PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
82     BEGIN
83          IF A'FIRST /= A'FIRST(1)
84             OR A'FIRST /= F1
85          THEN
86               FAILED ("'FIRST(1) IS WRONG " & S);
87          END IF;
88
89          IF A'LAST(1) /= L1 THEN
90               FAILED ("'LAST(1) IS WRONG " & S);
91          END IF;
92
93          IF A'LENGTH(1) /= A'LENGTH
94             OR A'LENGTH /= L1 - F1 + 1
95          THEN
96               FAILED ("'LENGTH(1) IS WRONG " & S);
97          END IF;
98
99          IF F1 - 1 IN A'RANGE
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)
103          THEN
104               FAILED ("'RANGE(1) IS WRONG " & S);
105          END IF;
106
107          IF A'FIRST(2) /= F2 THEN
108               FAILED ("'FIRST(2) IS WRONG " & S);
109          END IF;
110
111          IF A'LAST(2) /= L2 THEN
112               FAILED ("'LAST(2) IS WRONG " & S);
113          END IF;
114
115          IF L2 - F2 /= A'LENGTH(2) - 1 THEN
116               FAILED ("'LENGTH(2) IS WRONG " & S);
117          END IF;
118
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)
123          THEN
124               FAILED ("'RANGE(2) IS WRONG " & S);
125          END IF;
126     END P2;
127
128     PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
129     BEGIN
130          IF S'FIRST /= F THEN
131               FAILED ("STRING 'FIRST IS WRONG " & MESS);
132          END IF;
133
134          IF S'LAST(1) /= L THEN
135               FAILED ("STRING 'LAST IS WRONG " & MESS);
136          END IF;
137
138          IF S'LENGTH /= L - F + 1
139             OR S'LENGTH(1) /= S'LENGTH
140          THEN
141               FAILED ("STRING 'LENGTH IS WRONG " & MESS);
142          END IF;
143
144          IF (F <= L AND
145                (F NOT IN S'RANGE
146                OR L NOT IN S'RANGE
147                OR F NOT IN S'RANGE(1)
148                OR L NOT IN S'RANGE(1)))
149             OR F - 1 IN S'RANGE
150             OR L + 1 IN S'RANGE(1)
151          THEN
152               FAILED ("STRING 'RANGE IS WRONG " & MESS);
153          END IF;
154     END S1;
155
156BEGIN
157     TEST ( "C36205C", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
158                       "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
159                       "ARRAYS - NON-NULL DYNAMIC SLICES");
160
161     P1 (A10 (I10..I10), 10, 10, "P1 8");
162     P1 (A10 (I10 - 9 .. I10), 1, 10, "P1 9");
163
164     RESULT;
165END C36205C;
166