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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULTS WHEN
27 -- THE PREFIX IS AN INTEGER TYPE.
29 -- PART (A). TESTS FOR 'IMAGE'.
30 -- PART (B). TESTS FOR 'VALUE'.
33 -- RJW 03/17/86 CREATED ORIGINAL TEST.
34 -- VCL 10/23/87 MODIFIED THIS HEADER, ADDED A CHECK THAT
35 -- CONSTRAINT_ERROR IS RAISED FOR THE ATTRIBUTE
36 -- 'VALUE' IF THE FINAL SHARP OR COLON IS MISSING
37 -- FROM A BASED LITERAL.
39 WITH REPORT
; USE REPORT
;
41 TYPE NEWINT
IS NEW INTEGER;
42 TYPE INT
IS RANGE -1000 .. 1000;
44 FUNCTION IDENT
(X
: INT
) RETURN INT
IS
46 IF EQUAL
(INT
'POS (X
), INT
'POS(X
)) THEN
53 TEST
("C35503C", "THE ATTIBUTES 'IMAGE' AND 'VALUE' YIELD THE " &
54 "CORRECT RESULTS WHEN THE PREFIX IS AN " &
59 IF INTEGER'IMAGE (-500) /= "-500" THEN
60 FAILED
( "INCORRECT 'IMAGE' OF '-500'" );
62 IF INTEGER'IMAGE (-500)'FIRST /= 1 THEN
63 FAILED
( "INCORRECT LOWER BOUND FOR '-500'" );
66 IF NEWINT
'IMAGE (2 ** 6) /= " 64" THEN
67 FAILED
( "INCORRECT 'IMAGE' OF '2 ** 6'" );
69 IF NEWINT
'IMAGE (2 ** 6)'FIRST /= 1 THEN
70 FAILED
( "INCORRECT LOWER BOUND FOR '2 ** 6'" );
73 IF NATURAL'IMAGE (-1E2
) /= "-100" THEN
74 FAILED
( "INCORRECT 'IMAGE' OF '-1E2'" );
76 IF NATURAL'IMAGE (-1E2
)'FIRST /= 1 THEN
77 FAILED
( "INCORRECT LOWER BOUND FOR '-1E2'" );
80 IF NEWINT
'IMAGE (3_45
) /= " 345" THEN
81 FAILED
( "INCORRECT 'IMAGE' OF '3_45'" );
83 IF NEWINT
'IMAGE (3_45
)'FIRST /= 1 THEN
84 FAILED
( "INCORRECT LOWER BOUND FOR '3_45'" );
87 IF INTEGER'IMAGE (-2#
1111_1111#
) /= "-255" THEN
88 FAILED
( "INCORRECT 'IMAGE' OF '-2#1111_1111#'" );
90 IF INTEGER'IMAGE (-2#
1111_1111#
)'FIRST /= 1 THEN
91 FAILED
( "INCORRECT LOWER BOUND FOR '-2#1111_1111#'" );
94 IF NEWINT
'IMAGE (16#FF#
) /= " 255" THEN
95 FAILED
( "INCORRECT 'IMAGE' OF '16#FF#'" );
97 IF NEWINT
'IMAGE (16#FF#
)'FIRST /= 1 THEN
98 FAILED
( "INCORRECT LOWER BOUND FOR '16#FF#'" );
101 IF INTEGER'IMAGE (-016#
0FF#
) /= "-255" THEN
102 FAILED
( "INCORRECT 'IMAGE' OF '-016#0FF#'" );
104 IF INTEGER'IMAGE (-016#
0FF#
)'FIRST /= 1 THEN
105 FAILED
( "INCORRECT LOWER BOUND FOR '-016#0FF#'" );
108 IF NEWINT
'IMAGE (2#
1110_0000#
) /= " 224" THEN
109 FAILED
( "INCORRECT 'IMAGE' OF '2#1110_0000#'" );
111 IF NEWINT
'IMAGE (2#
1110_0000#
)'FIRST /= 1 THEN
112 FAILED
( "INCORRECT LOWER BOUND FOR '2#1110_0000#'" );
115 IF POSITIVE'IMAGE (-16#E#E1
) /= "-224" THEN
116 FAILED
( "INCORRECT 'IMAGE' OF '-16#E#E1'" );
118 IF POSITIVE'IMAGE (-16#E#E1
)'FIRST /= 1 THEN
119 FAILED
( "INCORRECT LOWER BOUND FOR '-16#E#E1'" );
122 IF INT
'IMAGE (IDENT
(-1000)) /= "-1000" THEN
123 FAILED
( "INCORRECT 'IMAGE' OF '-1000'" );
125 IF INT
'IMAGE (IDENT
(-1000))'FIRST /= 1 THEN
126 FAILED
( "INCORRECT LOWER BOUND FOR '-1000'" );
129 IF INT
'IMAGE (IDENT
(-999)) /= "-999" THEN
130 FAILED
( "INCORRECT 'IMAGE' OF '-999'" );
132 IF INT
'IMAGE (IDENT
(-999))'FIRST /= 1 THEN
133 FAILED
( "INCORRECT LOWER BOUND FOR '-999'" );
136 IF INT
'IMAGE (IDENT
(-10)) /= "-10" THEN
137 FAILED
( "INCORRECT 'IMAGE' OF '-1000'" );
139 IF INT
'IMAGE (IDENT
(-10))'FIRST /= 1 THEN
140 FAILED
( "INCORRECT LOWER BOUND FOR '-10'" );
143 IF INT
'IMAGE (IDENT
(-9)) /= "-9" THEN
144 FAILED
( "INCORRECT 'IMAGE' OF '-9'" );
146 IF INT
'IMAGE (IDENT
(-9))'FIRST /= 1 THEN
147 FAILED
( "INCORRECT LOWER BOUND FOR '-9'" );
150 IF INT
'IMAGE (IDENT
(-1)) /= "-1" THEN
151 FAILED
( "INCORRECT 'IMAGE' OF '-1'" );
153 IF INT
'IMAGE (IDENT
(-1))'FIRST /= 1 THEN
154 FAILED
( "INCORRECT LOWER BOUND FOR '-1'" );
157 IF INT
'IMAGE (IDENT
(0)) /= " 0" THEN
158 FAILED
( "INCORRECT 'IMAGE' OF '0'" );
160 IF INT
'IMAGE (IDENT
(0))'FIRST /= 1 THEN
161 FAILED
( "INCORRECT LOWER BOUND FOR '0'" );
164 IF INT
'IMAGE (IDENT
(1)) /= " 1" THEN
165 FAILED
( "INCORRECT 'IMAGE' OF '1'" );
167 IF INT
'IMAGE (IDENT
(1))'FIRST /= 1 THEN
168 FAILED
( "INCORRECT LOWER BOUND FOR '1'" );
171 IF INT
'IMAGE (IDENT
(9)) /= " 9" THEN
172 FAILED
( "INCORRECT 'IMAGE' OF '9'" );
174 IF INT
'IMAGE (IDENT
(9))'FIRST /= 1 THEN
175 FAILED
( "INCORRECT LOWER BOUND FOR '9'" );
178 IF INT
'IMAGE (IDENT
(10)) /= " 10" THEN
179 FAILED
( "INCORRECT 'IMAGE' OF '10'" );
181 IF INT
'IMAGE (IDENT
(10))'FIRST /= 1 THEN
182 FAILED
( "INCORRECT LOWER BOUND FOR '10'" );
185 IF INT
'IMAGE (IDENT
(999)) /= " 999" THEN
186 FAILED
( "INCORRECT 'IMAGE' OF '999'" );
188 IF INT
'IMAGE (IDENT
(999))'FIRST /= 1 THEN
189 FAILED
( "INCORRECT LOWER BOUND FOR '999'" );
192 IF INT
'IMAGE (IDENT
(1000)) /= " 1000" THEN
193 FAILED
( "INCORRECT 'IMAGE' OF '1000'" );
195 IF INT
'IMAGE (IDENT
(1000))'FIRST /= 1 THEN
196 FAILED
( "INCORRECT LOWER BOUND FOR '1000'" );
201 -----------------------------------------------------------------------
206 IF POSITIVE'VALUE (IDENT_STR
("-500")) /= -500 THEN
207 FAILED
( "INCORRECT 'VALUE' OF ""-500""" );
211 FAILED
( "EXCEPTION RAISED - 'VALUE' OF ""-500""" );
215 IF NEWINT
'VALUE (" -001E2") /= -100 THEN
216 FAILED
( "INCORRECT 'VALUE' OF "" -001E2""" );
220 FAILED
( "EXCEPTION RAISED - 'VALUE' OF "" -001E2""" );
224 IF INTEGER'VALUE ("03_45") /= 345 THEN
225 FAILED
( "INCORRECT 'VALUE' OF ""03_45""" );
229 FAILED
( "EXCEPTION RAISED - 'VALUE' OF ""03_45""" );
233 IF NEWINT
'VALUE ("-2#1111_1111#") /= -255 THEN
234 FAILED
( "INCORRECT 'VALUE' OF ""-2#1111_1111#""" );
238 FAILED
( "EXCEPTION RAISED - 'VALUE' OF "&
239 """-2#1111_1111#""" );
243 IF INTEGER'VALUE (IDENT_STR
("16#FF#")) /= 255 THEN
244 FAILED
( "INCORRECT 'VALUE' OF ""16#FF#""" );
248 FAILED
( "EXCEPTION RAISED - 'VALUE' OF ""16#FF#""" );
252 IF NATURAL'VALUE (IDENT_STR
("-016#0FF#")) /= -255 THEN
253 FAILED
( "INCORRECT 'VALUE' OF ""-016#0FF#""" );
257 FAILED
( "EXCEPTION RAISED - 'VALUE' OF " &
262 IF INTEGER'VALUE ("2#1110_0000# ") /= 224 THEN
263 FAILED
( "INCORRECT 'VALUE' OF " &
264 """2#1110_0000# """ );
268 FAILED
( "EXCEPTION RAISED - 'VALUE' OF " &
269 """2#1110_0000# """ );
273 IF NEWINT
'VALUE (" -16#E#E1") /= -224 THEN
274 FAILED
( "INCORRECT 'VALUE' OF "" -16#E#E1""" );
278 FAILED
( "EXCEPTION RAISED - 'VALUE' OF " &
283 IF INTEGER'VALUE ("5/0") = 0 THEN
284 FAILED
( "NO EXCEPTION RAISED - ""5/0"" - 1" );
286 FAILED
( "NO EXCEPTION RAISED - ""5/0"" - 2" );
289 WHEN CONSTRAINT_ERROR
=>
292 FAILED
( "WRONG EXCEPTION RAISED - ""5/0""" );
296 SUBTYPE SUBINT
IS INTEGER RANGE 0 .. 10;
298 IF SUBINT
'VALUE (IDENT_STR
("-500")) /= -500 THEN
299 FAILED
( "INCORRECT VALUE WITH ""-500"" AND SUBINT" );
303 FAILED
( "EXCEPTION RAISED - SUBINT" );
307 IF INTEGER'VALUE (IDENT_STR
("1.0")) = 1 THEN
308 FAILED
( "NO EXCEPTION RAISED - "" 1.0"" - 1" );
310 FAILED
( "NO EXCEPTION RAISED - ""1.0"" - 2" );
313 WHEN CONSTRAINT_ERROR
=>
316 FAILED
( "WRONG EXCEPTION RAISED - ""1.0"" " );
320 IF INTEGER'VALUE (IDENT_CHAR
(ASCII
.HT
) & "244") /= 244 THEN
321 FAILED
( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
323 FAILED
( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
326 WHEN CONSTRAINT_ERROR
=>
329 FAILED
( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
333 IF INTEGER'VALUE ("244" & (IDENT_CHAR
(ASCII
.HT
))) /= 244 THEN
334 FAILED
( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
336 FAILED
( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
339 WHEN CONSTRAINT_ERROR
=>
342 FAILED
( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
346 IF INTEGER'VALUE (IDENT_STR
("2__44")) /= 244 THEN
347 FAILED
( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 1" );
349 FAILED
( "NO EXCEPTION RAISED - CONSECUTIVE '_' - 2" );
352 WHEN CONSTRAINT_ERROR
=>
355 FAILED
( "WRONG EXCEPTION RAISED " &
356 "WITH CONSECUTIVE '_'" );
360 IF INTEGER'VALUE (IDENT_STR
("_244")) /= 244 THEN
361 FAILED
( "NO EXCEPTION RAISED - LEADING '_' - 1" );
363 FAILED
( "NO EXCEPTION RAISED - LEADING '_' - 2" );
366 WHEN CONSTRAINT_ERROR
=>
369 FAILED
( "WRONG EXCEPTION RAISED - LEADING '_'" );
373 IF INTEGER'VALUE (IDENT_STR
("244_")) /= 244 THEN
374 FAILED
( "NO EXCEPTION RAISED - TRAILING '_' - 1" );
376 FAILED
( "NO EXCEPTION RAISED - TRAILING '_' - 2" );
379 WHEN CONSTRAINT_ERROR
=>
382 FAILED
( "WRONG EXCEPTION RAISED - TRAILING '_'" );
386 IF INTEGER'VALUE (IDENT_STR
("244_E1")) /= 2440 THEN
387 FAILED
( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 1" );
389 FAILED
( "NO EXCEPTION RAISED - '_' BEFORE 'E' - 2" );
392 WHEN CONSTRAINT_ERROR
=>
395 FAILED
( "WRONG EXCEPTION RAISED - '_' BEFORE 'E'" );
399 IF INTEGER'VALUE (IDENT_STR
("244E_1")) /= 2440 THEN
400 FAILED
( "NO EXCEPTION RAISED - '_' " &
401 "FOLLOWING 'E' - 1" );
403 FAILED
( "NO EXCEPTION RAISED - '_' FOLLOWING 'E' - 2" );
406 WHEN CONSTRAINT_ERROR
=>
409 FAILED
( "WRONG EXCEPTION RAISED " &
410 "- '_' FOLLOWING 'E'" );
414 IF INTEGER'VALUE (IDENT_STR
("244_e1")) /= 2440 THEN
415 FAILED
( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 1" );
417 FAILED
( "NO EXCEPTION RAISED - '_' BEFORE 'e' - 2" );
420 WHEN CONSTRAINT_ERROR
=>
423 FAILED
( "WRONG EXCEPTION RAISED - '_' BEFORE 'e'" );
427 IF INTEGER'VALUE (IDENT_STR
("16#_FF#")) /= 255 THEN
428 FAILED
( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
431 FAILED
( "NO EXCEPTION RAISED - LEADING '_' IN BASED " &
435 WHEN CONSTRAINT_ERROR
=>
438 FAILED
( "WRONG EXCEPTION RAISED " &
439 "- LEADING '_' IN BASED LITERAL" );
443 IF INTEGER'VALUE (IDENT_STR
("1E-0")) /= 1 THEN
444 FAILED
( "NO EXCEPTION RAISED - NEGATIVE " &
447 FAILED
( "NO EXCEPTION RAISED - NEGATIVE EXPONENT - 2" );
450 WHEN CONSTRAINT_ERROR
=>
453 FAILED
( "WRONG EXCEPTION RAISED " &
454 "- NEGATIVE EXPONENT" );
458 IF INTEGER'VALUE (IDENT_STR
("244.")) /= 244 THEN
459 FAILED
( "NO EXCEPTION RAISED - TRAILING '.' - 1" );
461 FAILED
( "NO EXCEPTION RAISED - TRAILING '.' - 2" );
464 WHEN CONSTRAINT_ERROR
=>
467 FAILED
( "WRONG EXCEPTION RAISED - TRAILING '.'" );
471 IF INTEGER'VALUE (IDENT_STR
("8#811#")) /= 0 THEN
472 FAILED
( "NO EXCEPTION RAISED - " &
473 "DIGITS NOT IN CORRECT RANGE - 1" );
475 FAILED
( "NO EXCEPTION RAISED - " &
476 "DIGITS NOT IN CORRECT RANGE - 2" );
479 WHEN CONSTRAINT_ERROR
=>
482 FAILED
( "WRONG EXCEPTION RAISED - " &
483 "DIGITS NOT IN CORRECT RANGE" );
487 IF INTEGER'VALUE (IDENT_STR
("1#000#")) /= 0 THEN
488 FAILED
( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 1" );
490 FAILED
( "NO EXCEPTION RAISED - BASE LESS THAN 2 - 2" );
493 WHEN CONSTRAINT_ERROR
=>
496 FAILED
( "WRONG EXCEPTION RAISED " &
497 "- BASE LESS THAN 2" );
501 IF INTEGER'VALUE (IDENT_STR
("17#0#")) /= 0 THEN
502 FAILED
( "NO EXCEPTION RAISED " &
503 "- BASE GREATER THAN 16 - 1" );
505 FAILED
( "NO EXCEPTION RAISED " &
506 "- BASE GREATER THAN 16 - 2" );
509 WHEN CONSTRAINT_ERROR
=>
512 FAILED
( "WRONG EXCEPTION RAISED " &
513 "- BASE GREATER THAN 16" );
517 IF INTEGER'VALUE (IDENT_STR
("8#666")) /= 438 THEN
518 FAILED
("NO EXCEPTION RAISED - MISSING FINAL SHARP - 1");
520 FAILED
("NO EXCEPTION RAISED - MISSING FINAL SHARP - 2");
523 WHEN CONSTRAINT_ERROR
=>
526 FAILED
("WRONG EXCEPTION RAISED - MISSING FINAL SHARP");
530 IF INTEGER'VALUE (IDENT_STR
("16:FF")) /= 255 THEN
531 FAILED
("NO EXCEPTION RAISED - MISSING FINAL COLON - 1");
533 FAILED
("NO EXCEPTION RAISED - MISSING FINAL COLON - 2");
536 WHEN CONSTRAINT_ERROR
=>
539 FAILED
("WRONG EXCEPTION RAISED - MISSING FINAL COLON");