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 WHEN SIZE AND SMALL SPECIFICATIONS ARE GIVEN FOR A
27 -- FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE ARE
28 -- NOT AFFECTED BY THE REPRESENTATION CLAUSE.
30 -- APPLICABILITY CRITERIA:
31 -- All implementations must attempt to compile this test.
33 -- For implementations validating against Systems Programming Annex (C)
34 -- and which support decimal small values:
35 -- The test must compile, bind, execute, report PASSED, and
38 -- For other implementations:
39 -- This test may produce at least one error message at compilation,
40 -- and the error message is associated with one of the items marked:
42 -- The test will be recorded as Not_Applicable.
43 -- Otherwise, the test must execute and report PASSED.
45 -- All other behaviors are FAILING.
48 -- BCB 08/24/87 CREATED ORIGINAL TEST.
49 -- DHH 04/12/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
50 -- OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
51 -- SO THAT IT IS NOT A POWER OF TWO.
52 -- WMC 04/01/92 ELIMINATED TEST REDUNDANCIES.
53 -- RLB 11/24/98 Added Ada 95 applicability criteria.
55 WITH REPORT
; USE REPORT
;
57 BASIC_SIZE
: CONSTANT := 15;
58 BASIC_SMALL
: CONSTANT := 0.01;
60 ZERO
: CONSTANT := 0.0;
62 TYPE CHECK_TYPE
IS DELTA 1.0 RANGE -4.0 .. 4.0;
64 FOR CHECK_TYPE
'SMALL USE BASIC_SMALL
; -- N/A => ERROR.
65 FOR CHECK_TYPE
'SIZE USE BASIC_SIZE
; -- N/A => ERROR.
67 CNEG1
: CHECK_TYPE
:= -2.7;
68 CNEG2
: CHECK_TYPE
:= CHECK_TYPE
(-1.0/3.0);
69 CPOS1
: CHECK_TYPE
:= CHECK_TYPE
(4.0/6.0);
70 CPOS2
: CHECK_TYPE
:= 2.7;
73 TYPE ARRAY_TYPE
IS ARRAY (0 .. 3) OF CHECK_TYPE
;
74 CHARRAY
: ARRAY_TYPE
:=
75 (-2.7, CHECK_TYPE
(-1.0/3.0), CHECK_TYPE
(4.0/6.0), 2.7);
77 TYPE REC_TYPE
IS RECORD
78 COMPF
: CHECK_TYPE
:= -2.7;
79 COMPN
: CHECK_TYPE
:= CHECK_TYPE
(-1.0/3.0);
80 COMPP
: CHECK_TYPE
:= CHECK_TYPE
(4.0/6.0);
81 COMPL
: CHECK_TYPE
:= 2.7;
86 FUNCTION IDENT
(FX
: CHECK_TYPE
) RETURN CHECK_TYPE
IS
95 PROCEDURE PROC
(CN1IN
, CP1IN
: CHECK_TYPE
;
96 CN2INOUT
,CP2INOUT
: IN OUT CHECK_TYPE
;
97 CZOUT
: OUT CHECK_TYPE
) IS
100 IF IDENT
(CN1IN
) + CP1IN
NOT IN -2.04 .. -2.03 OR
101 CP2INOUT
- IDENT
(CP1IN
) NOT IN 2.03 .. 2.04 THEN
102 FAILED
("INCORRECT RESULTS FOR " &
103 "BINARY ADDING OPERATORS - 1");
106 IF CHECK_TYPE
(CN1IN
* IDENT
(CP1IN
)) NOT IN
108 CHECK_TYPE
(IDENT
(CN2INOUT
) / CP2INOUT
) NOT IN
110 FAILED
("INCORRECT RESULTS FOR " &
111 "MULTIPLYING OPERATORS - 1");
114 IF IDENT
(CP1IN
) NOT IN 0.66 .. 0.670 OR
115 CN2INOUT
IN -0.32 .. 0.0 OR
116 IDENT
(CN2INOUT
) IN -1.0 .. -0.35 THEN
117 FAILED
("INCORRECT RESULTS FOR MEMBERSHIP " &
126 TEST
("CD2A53A", "CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS " &
127 "ARE GIVEN FOR A FIXED POINT TYPE, THEN " &
128 "OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT " &
129 "AFFECTED BY THE REPRESENTATION CLAUSE");
131 PROC
(CNEG1
, CPOS1
, CNEG2
, CPOS2
, CZERO
);
133 IF CNEG1
'SIZE < IDENT_INT
(BASIC_SIZE
) THEN
134 FAILED
("INCORRECT VALUE FOR CNEG1'SIZE");
137 IF IDENT
(CZERO
) /= ZERO
THEN
138 FAILED
("INCORRECT VALUE FOR OUT PARAMETER");
141 IF CHECK_TYPE
'FIRST > IDENT
(-3.99) THEN
142 FAILED
("INCORRECT VALUE FOR CHECK_TYPE'FIRST");
145 IF CHECK_TYPE
'SIZE /= IDENT_INT
(BASIC_SIZE
) THEN
146 FAILED
("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
149 IF CHECK_TYPE
'SMALL /= BASIC_SMALL
THEN
150 FAILED
("INCORRECT VALUE FOR CHECK_TYPE'SMALL");
153 IF CHECK_TYPE
'FORE /= 2 THEN
154 FAILED
("INCORRECT VALUE FOR CHECK_TYPE'FORE");
157 IF +IDENT
(CNEG2
) NOT IN -0.34 .. -0.33 OR
158 IDENT
(-CPOS1
) NOT IN -0.67 .. -0.66 THEN
159 FAILED
("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 2");
162 IF ABS IDENT
(CNEG2
) NOT IN 0.33 .. 0.34 OR
163 IDENT
(ABS CPOS1
) NOT IN 0.66 .. 0.670 THEN
164 FAILED
("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
168 IF CHARRAY
(1)'SIZE < IDENT_INT
(BASIC_SIZE
) THEN
169 FAILED
("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
172 IF IDENT
(CHARRAY
(0)) + CHARRAY
(2) NOT IN
174 CHARRAY
(3) - IDENT
(CHARRAY
(2)) NOT IN
176 FAILED
("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 3");
179 IF CHECK_TYPE
(CHARRAY
(0) * IDENT
(CHARRAY
(2))) NOT IN
181 CHECK_TYPE
(IDENT
(CHARRAY
(1)) / CHARRAY
(3)) NOT IN
183 FAILED
("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 3");
186 IF IDENT
(CHARRAY
(2)) NOT IN 0.66 .. 0.670 OR
187 CHARRAY
(1) IN -0.32 .. 0.0 OR
188 IDENT
(CHARRAY
(1)) IN -1.0 .. -0.35 THEN
189 FAILED
("INCORRECT RESULTS FOR MEMBERSHIP " &
193 IF CHREC
.COMPP
'SIZE < IDENT_INT
(BASIC_SIZE
) THEN
194 FAILED
("INCORRECT VALUE FOR CHREC.COMPP'SIZE");
197 IF +IDENT
(CHREC
.COMPN
) NOT IN -0.34 .. -0.33 OR
198 IDENT
(-CHREC
.COMPP
) NOT IN -0.67 .. -0.66 THEN
199 FAILED
("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 4");
202 IF ABS IDENT
(CHREC
.COMPN
) NOT IN 0.33 .. 0.34 OR
203 IDENT
(ABS CHREC
.COMPP
) NOT IN 0.66 .. 0.670 THEN
204 FAILED
("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
208 IF IDENT
(CHREC
.COMPP
) NOT IN 0.66 .. 0.670 OR
209 CHREC
.COMPN
IN -0.32 .. 0.0 OR
210 IDENT
(CHREC
.COMPN
) IN -1.0 .. -0.35 THEN
211 FAILED
("INCORRECT RESULTS FOR MEMBERSHIP " &