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.
26 -- CHECK THAT AFTER A GENERIC UNIT IS INSTANTIATED, THE SUBTYPE OF
27 -- AN IN OUT OBJECT PARAMETER IS DETERMINED BY THE ACTUAL PARAMETER
28 -- (TESTS INTEGER, ENUMERATION, FLOATING POINT, FIXED POINT, ARRAY,
29 -- ACCESS, AND DISCRIMINATED TYPES).
32 -- BCB 03/28/88 CREATED ORIGINAL TEST.
33 -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
35 WITH REPORT
; USE REPORT
;
39 SUBTYPE INT
IS INTEGER RANGE 0..5;
40 INTVAR
: INTEGER RANGE 1..3;
42 TYPE ENUM
IS (ONE
, TWO
, THREE
, FOUR
, FIVE
, SIX
, SEVEN
, EIGHT
);
43 SUBTYPE SUBENUM
IS ENUM
RANGE ONE
.. FIVE
;
44 ENUMVAR
: ENUM
RANGE TWO
.. THREE
;
46 TYPE FLT
IS DIGITS 5 RANGE -5.0 .. 5.0;
47 SUBTYPE SUBFLT
IS FLT
RANGE -1.0 .. 1.0;
48 FLTVAR
: FLT
RANGE 0.0 .. 1.0;
50 TYPE FIX
IS DELTA 0.5 RANGE -5.0 .. 5.0;
51 SUBTYPE SUBFIX
IS FIX
RANGE -1.0 .. 1.0;
52 FIXVAR
: FIX
RANGE 0.0 .. 1.0;
54 SUBTYPE STR
IS STRING (1..10);
55 STRVAR
: STRING (1..5);
57 TYPE REC
(DISC
: INTEGER := 5) IS RECORD
60 SUBTYPE SUBREC
IS REC
(6);
64 TYPE ACCREC
IS ACCESS REC
;
65 SUBTYPE A1
IS ACCREC
(1);
66 SUBTYPE A2
IS ACCREC
(2);
67 A1VAR
: A1
:= NEW REC
(1);
68 A2VAR
: A2
:= NEW REC
(2);
73 TYPE PRIV
IS RANGE 1 .. 100;
74 SUBTYPE SUBPRIV
IS PRIV
RANGE 5 .. 10;
75 PRIVVAR
: PRIV
RANGE 8 .. 10;
79 FUNCTION PRIVEQUAL
(ONE
, TWO
: SUBPRIV
) RETURN BOOLEAN;
81 FUNCTION PRIVEQUAL
(ONE
, TWO
: SUBPRIV
) RETURN BOOLEAN IS
88 OUTPUT
: IN OUT SUBPRIV
;
94 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
96 IF PRIVEQUAL
(OUTPUT
, OUTPUT
) THEN
97 COMMENT
("DON'T OPTIMIZE OUTPUT");
100 WHEN CONSTRAINT_ERROR
=>
103 FAILED
("WRONG EXCEPTION RAISED");
106 PROCEDURE I1
IS NEW I
(5, PRIVVAR
);
107 PROCEDURE I2
IS NEW I
(SUBPRIV
'FIRST, PRIVVAR
);
110 TEST
("CC1111A", "CHECK THAT AFTER A GENERIC UNIT IS " &
111 "INSTANTIATED, THE SUBTYPE OF AN IN OUT " &
112 "OBJECT PARAMETER IS DETERMINED BY THE " &
113 "ACTUAL PARAMETER (TESTS INTEGER, " &
114 "ENUMERATION, FLOATING POINT, FIXED POINT " &
115 ", ARRAY, ACCESS, AND DISCRIMINATED TYPES)");
125 FUNCTION GEN_IDENT
(X
: GP
) RETURN GP
;
134 OUTPUT
: IN OUT SUBENUM
;
139 OUTPUT
: IN OUT SUBFLT
;
144 OUTPUT
: IN OUT SUBFIX
;
159 OUTPUT
: IN OUT SUBREC
;
164 FUNCTION GENEQUAL
(ONE
, TWO
: GP
) RETURN BOOLEAN;
166 FUNCTION GENEQUAL
(ONE
, TWO
: GP
) RETURN BOOLEAN IS
171 FUNCTION GEN_IDENT
(X
: GP
) RETURN GP
IS
176 FUNCTION INT_IDENT
IS NEW GEN_IDENT
(INT
);
177 FUNCTION SUBENUM_IDENT
IS NEW GEN_IDENT
(SUBENUM
);
178 FUNCTION SUBFLT_IDENT
IS NEW GEN_IDENT
(SUBFLT
);
179 FUNCTION SUBFIX_IDENT
IS NEW GEN_IDENT
(SUBFIX
);
181 FUNCTION ENUMEQUAL
IS NEW GENEQUAL
(SUBENUM
);
182 FUNCTION FLTEQUAL
IS NEW GENEQUAL
(SUBFLT
);
183 FUNCTION FIXEQUAL
IS NEW GENEQUAL
(SUBFIX
);
184 FUNCTION STREQUAL
IS NEW GENEQUAL
(STR
);
185 FUNCTION ACCEQUAL
IS NEW GENEQUAL
(A2
);
186 FUNCTION RECEQUAL
IS NEW GENEQUAL
(REC
);
191 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
193 IF EQUAL
(OUTPUT
, OUTPUT
) THEN
194 COMMENT
("DON'T OPTIMIZE OUTPUT");
197 WHEN CONSTRAINT_ERROR
=>
200 FAILED
("WRONG EXCEPTION RAISED");
206 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
208 IF ENUMEQUAL
(OUTPUT
, OUTPUT
) THEN
209 COMMENT
("DON'T OPTIMIZE OUTPUT");
212 WHEN CONSTRAINT_ERROR
=>
215 FAILED
("WRONG EXCEPTION RAISED");
221 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
222 "FLOATING POINT TYPE");
223 IF FLTEQUAL
(OUTPUT
, OUTPUT
) THEN
224 COMMENT
("DON'T OPTIMIZE OUTPUT");
227 WHEN CONSTRAINT_ERROR
=>
230 FAILED
("WRONG EXCEPTION RAISED");
236 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
238 IF FIXEQUAL
(OUTPUT
, OUTPUT
) THEN
239 COMMENT
("DON'T OPTIMIZE OUTPUT");
242 WHEN CONSTRAINT_ERROR
=>
245 FAILED
("WRONG EXCEPTION RAISED");
251 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
253 IF STREQUAL
(OUTPUT
, OUTPUT
) THEN
254 COMMENT
("DON'T OPTIMIZE OUTPUT");
257 WHEN CONSTRAINT_ERROR
=>
260 FAILED
("WRONG EXCEPTION RAISED");
266 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
268 IF ACCEQUAL
(OUTPUT
, OUTPUT
) THEN
269 COMMENT
("DON'T OPTIMIZE OUTPUT");
272 WHEN CONSTRAINT_ERROR
=>
275 FAILED
("WRONG EXCEPTION RAISED");
281 FAILED
("SUBTYPE NOT DETERMINED BY ACTUAL PARAMETER - " &
282 "DISCRIMINATED RECORD TYPE");
283 IF RECEQUAL
(OUTPUT
, OUTPUT
) THEN
284 COMMENT
("DON'T OPTIMIZE OUTPUT");
287 WHEN CONSTRAINT_ERROR
=>
290 FAILED
("WRONG EXCEPTION RAISED");
293 PROCEDURE B1
IS NEW B
(4, INTVAR
);
294 PROCEDURE C1
IS NEW C
(FOUR
, ENUMVAR
);
295 PROCEDURE D1
IS NEW D
(-1.0, FLTVAR
);
296 PROCEDURE E1
IS NEW E
(-1.0, FIXVAR
);
297 PROCEDURE F1
IS NEW F
("9876543210", STRVAR
);
298 PROCEDURE G1
IS NEW G
(A1VAR
, A2VAR
);
299 PROCEDURE H1
IS NEW H
(SUBRECVAR
, RECVAR
);
301 PROCEDURE B2
IS NEW B
(INT_IDENT
(INT
'FIRST), INTVAR
);
302 PROCEDURE C2
IS NEW C
(SUBENUM_IDENT
(SUBENUM
'FIRST), ENUMVAR
);
303 PROCEDURE D2
IS NEW D
(SUBFLT_IDENT
(SUBFLT
'FIRST), FLTVAR
);
304 PROCEDURE E2
IS NEW E
(SUBFIX_IDENT
(SUBFIX
'FIRST), FIXVAR
);