|
111
|
1 -- CC3601A.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 PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL
|
|
|
26 -- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN
|
|
|
27 -- CC3601C).
|
|
|
28
|
|
|
29 -- R.WILLIAMS 10/9/86
|
|
|
30 -- JRL 11/15/95 Added unknown discriminant part to all formal
|
|
|
31 -- private types.
|
|
|
32
|
|
|
33
|
|
|
34 WITH REPORT; USE REPORT;
|
|
|
35 PROCEDURE CC3601A IS
|
|
|
36
|
|
|
37 GENERIC
|
|
|
38 TYPE T (<>) IS PRIVATE;
|
|
|
39 V, V1 : T;
|
|
|
40 KIND : STRING;
|
|
|
41 WITH FUNCTION F1 (X : IN T) RETURN T;
|
|
|
42 PACKAGE GP1 IS
|
|
|
43 R : BOOLEAN := F1 (V) = V1;
|
|
|
44 END GP1;
|
|
|
45
|
|
|
46 PACKAGE BODY GP1 IS
|
|
|
47 BEGIN
|
|
|
48 IF NOT (IDENT_BOOL(R)) THEN
|
|
|
49 FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND);
|
|
|
50 END IF;
|
|
|
51 END GP1;
|
|
|
52
|
|
|
53 GENERIC
|
|
|
54 TYPE T (<>) IS PRIVATE;
|
|
|
55 V, V1, V2 : IN T;
|
|
|
56 KIND : STRING;
|
|
|
57 WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T;
|
|
|
58 PACKAGE GP2 IS
|
|
|
59 R : BOOLEAN := V /= F1 (V1, V2);
|
|
|
60 END GP2;
|
|
|
61
|
|
|
62 PACKAGE BODY GP2 IS
|
|
|
63 BEGIN
|
|
|
64 IF IDENT_BOOL (R) THEN
|
|
|
65 FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND);
|
|
|
66 END IF;
|
|
|
67 END GP2;
|
|
|
68
|
|
|
69
|
|
|
70 GENERIC
|
|
|
71 TYPE T1 (<>) IS PRIVATE;
|
|
|
72 TYPE T2 (<>) IS PRIVATE;
|
|
|
73 V1 : T1;
|
|
|
74 V2 : T2;
|
|
|
75 KIND : STRING;
|
|
|
76 WITH FUNCTION F1 (X : IN T1) RETURN T2;
|
|
|
77 PACKAGE GP3 IS
|
|
|
78 R : BOOLEAN := F1 (V1) = V2;
|
|
|
79 END GP3;
|
|
|
80
|
|
|
81 PACKAGE BODY GP3 IS
|
|
|
82 BEGIN
|
|
|
83 IF NOT (IDENT_BOOL(R)) THEN
|
|
|
84 FAILED ( "INCORRECT VALUE FOR OP - " & KIND);
|
|
|
85 END IF;
|
|
|
86 END GP3;
|
|
|
87
|
|
|
88 BEGIN
|
|
|
89 TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " &
|
|
|
90 "PASSED AS ACTUAL GENERIC SUBPROGRAM " &
|
|
|
91 "PARAMETERS" );
|
|
|
92
|
|
|
93
|
|
|
94 BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS
|
|
|
95 -- ACTUAL PARAMETERS.
|
|
|
96
|
|
|
97 FOR I1 IN BOOLEAN LOOP
|
|
|
98
|
|
|
99 FOR I2 IN BOOLEAN LOOP
|
|
|
100 COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " &
|
|
|
101 "B2 = " & BOOLEAN'IMAGE (I2) );
|
|
|
102 DECLARE
|
|
|
103 B1 : BOOLEAN := IDENT_BOOL (I1);
|
|
|
104 B2 : BOOLEAN := IDENT_BOOL (I2);
|
|
|
105
|
|
|
106 PACKAGE P1 IS
|
|
|
107 NEW GP1 (BOOLEAN, NOT B2, B2,
|
|
|
108 """NOT"" - 1", "NOT");
|
|
|
109 PACKAGE P2 IS
|
|
|
110 NEW GP2 (BOOLEAN, B1 OR B2, B1, B2,
|
|
|
111 "OR", "OR");
|
|
|
112 PACKAGE P3 IS
|
|
|
113 NEW GP2 (BOOLEAN, B1 AND B2, B2, B1,
|
|
|
114 "AND", "AND");
|
|
|
115 PACKAGE P4 IS
|
|
|
116 NEW GP2 (BOOLEAN, B1 /= B2, B1, B2,
|
|
|
117 "XOR", "XOR");
|
|
|
118 PACKAGE P5 IS
|
|
|
119 NEW GP2 (BOOLEAN, B1 < B2, B1, B2,
|
|
|
120 "<", "<");
|
|
|
121 PACKAGE P6 IS
|
|
|
122 NEW GP2 (BOOLEAN, B1 <= B2, B1, B2,
|
|
|
123 "<=", "<=");
|
|
|
124 PACKAGE P7 IS
|
|
|
125 NEW GP2 (BOOLEAN, B1 > B2, B1, B2,
|
|
|
126 ">", ">");
|
|
|
127 PACKAGE P8 IS
|
|
|
128 NEW GP2 (BOOLEAN, B1 >= B2, B1, B2,
|
|
|
129 ">=", ">=");
|
|
|
130
|
|
|
131 TYPE AB IS ARRAY (BOOLEAN RANGE <> )
|
|
|
132 OF BOOLEAN;
|
|
|
133 AB1 : AB (BOOLEAN) := (B1, B2);
|
|
|
134 AB2 : AB (BOOLEAN) := (B2, B1);
|
|
|
135 T : AB (B1 .. B2) := (B1 .. B2 => TRUE);
|
|
|
136 F : AB (B1 .. B2) := (B1 .. B2 => FALSE);
|
|
|
137 VB1 : AB (B1 .. B1) := (B1 => B2);
|
|
|
138 VB2 : AB (B2 .. B2) := (B2 => B1);
|
|
|
139
|
|
|
140 PACKAGE P9 IS
|
|
|
141 NEW GP1 (AB, AB1, NOT AB1,
|
|
|
142 """NOT"" - 2", "NOT");
|
|
|
143 PACKAGE P10 IS
|
|
|
144 NEW GP1 (AB, T, F,
|
|
|
145 """NOT"" - 3", "NOT");
|
|
|
146 PACKAGE P11 IS
|
|
|
147 NEW GP1 (AB, VB2, (B2 => NOT B1),
|
|
|
148 """NOT"" - 4", "NOT");
|
|
|
149 PACKAGE P12 IS
|
|
|
150 NEW GP2 (AB, AB1 AND AB2, AB1, AB2,
|
|
|
151 "AND", "AND");
|
|
|
152 BEGIN
|
|
|
153 NULL;
|
|
|
154 END;
|
|
|
155 END LOOP;
|
|
|
156 END LOOP;
|
|
|
157 END;
|
|
|
158
|
|
|
159 DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**",
|
|
|
160 -- AND "ABS".
|
|
|
161
|
|
|
162 PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+");
|
|
|
163
|
|
|
164 PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+");
|
|
|
165
|
|
|
166 PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3",
|
|
|
167 "+");
|
|
|
168 PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-");
|
|
|
169
|
|
|
170 PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-");
|
|
|
171
|
|
|
172 PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3",
|
|
|
173 "-");
|
|
|
174 PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+");
|
|
|
175
|
|
|
176 PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2",
|
|
|
177 "+");
|
|
|
178 PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3",
|
|
|
179 "+");
|
|
|
180 PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1",
|
|
|
181 "-" );
|
|
|
182 PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0,
|
|
|
183 """-"" - 2", "-");
|
|
|
184 PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3",
|
|
|
185 "-");
|
|
|
186
|
|
|
187 SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2;
|
|
|
188 TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER;
|
|
|
189 VSTR : STR (0 .. 1) := "AB";
|
|
|
190
|
|
|
191 PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) &
|
|
|
192 VSTR (1 .. 1),
|
|
|
193 VSTR (0 .. 0),
|
|
|
194 VSTR (1 .. 1), """&"" - 1", "&");
|
|
|
195
|
|
|
196 PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) &
|
|
|
197 VSTR (0 .. 0),
|
|
|
198 VSTR (1 .. 1),
|
|
|
199 VSTR (0 .. 0), """&"" - 2", "&");
|
|
|
200
|
|
|
201 PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*");
|
|
|
202
|
|
|
203 PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2",
|
|
|
204 "*");
|
|
|
205 PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/");
|
|
|
206
|
|
|
207 PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2",
|
|
|
208 "/");
|
|
|
209 PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM");
|
|
|
210
|
|
|
211 PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD");
|
|
|
212
|
|
|
213 PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS");
|
|
|
214
|
|
|
215 PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2",
|
|
|
216 "ABS");
|
|
|
217
|
|
|
218 PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3",
|
|
|
219 "ABS");
|
|
|
220
|
|
|
221 PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1",
|
|
|
222 "**");
|
|
|
223
|
|
|
224 PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2",
|
|
|
225 "**");
|
|
|
226
|
|
|
227 BEGIN
|
|
|
228 NULL;
|
|
|
229 END;
|
|
|
230
|
|
|
231 DECLARE -- CHECKS WITH ATTRIBUTES.
|
|
|
232
|
|
|
233 TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI);
|
|
|
234
|
|
|
235 PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC",
|
|
|
236 WEEKDAY'SUCC);
|
|
|
237
|
|
|
238 PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED",
|
|
|
239 WEEKDAY'PRED);
|
|
|
240
|
|
|
241 PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR",
|
|
|
242 "WEEKDAY'IMAGE", WEEKDAY'IMAGE);
|
|
|
243
|
|
|
244 PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI,
|
|
|
245 "WEEKDAY'VALUE", WEEKDAY'VALUE);
|
|
|
246 BEGIN
|
|
|
247 NULL;
|
|
|
248 END;
|
|
|
249
|
|
|
250 RESULT;
|
|
|
251 END CC3601A;
|
