1-- CD2A51A.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-- OBJECTIVE:
26--     CHECK THAT WHEN A SIZE SPECIFICATION IS GIVEN FOR A
27--     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
28--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
29
30-- HISTORY:
31--     RJW 08/12/87  CREATED ORIGINAL TEST.
32--     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
33--                   OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
34--                   SO THAT IT IS NOT A POWER OF TWO.
35--     WMC 03/31/92  ELIMINATED TEST REDUNDANCIES.
36--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
37
38WITH REPORT; USE REPORT;
39PROCEDURE CD2A51A IS
40
41     BASIC_SIZE : CONSTANT := 9;
42
43     TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
44
45     TYPE CHECK_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
46
47     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
48
49     CNEG1 : CHECK_TYPE := -3.5;
50     CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
51     CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
52     CPOS2 : CHECK_TYPE :=  3.5;
53     CZERO : CHECK_TYPE;
54
55     TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
56     CHARRAY : ARRAY_TYPE :=
57          (-3.5, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 3.5);
58
59     TYPE REC_TYPE IS RECORD
60          COMPN1 : CHECK_TYPE := -3.5;
61          COMPN2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
62          COMPP1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
63          COMPP2 : CHECK_TYPE :=  3.5;
64     END RECORD;
65
66     CHREC : REC_TYPE;
67
68     FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
69     BEGIN
70          IF EQUAL (3, 3) THEN
71               RETURN FX;
72          ELSE
73               RETURN 0.0;
74          END IF;
75     END IDENT;
76
77     PROCEDURE PROC (N1_IN, P1_IN      :        CHECK_TYPE;
78                     N2_INOUT,P2_INOUT : IN OUT CHECK_TYPE;
79                     CZOUT             :    OUT CHECK_TYPE) IS
80     BEGIN
81
82          IF +IDENT (N2_INOUT) NOT IN -0.375 .. -0.3125 OR
83             IDENT (-P1_IN) NOT IN -0.6875 .. -0.625 THEN
84               FAILED ("INCORRECT RESULTS FOR " &
85                       "UNARY ADDING OPERATORS - 1");
86          END IF;
87
88          IF ABS IDENT (N2_INOUT) NOT IN 0.3125 .. 0.375 OR
89             IDENT (ABS P1_IN) NOT IN 0.625 .. 0.6875 THEN
90               FAILED ("INCORRECT RESULTS FOR " &
91                       "ABSOLUTE VALUE OPERATORS - 1");
92          END IF;
93
94          CZOUT := 0.0;
95
96     END PROC;
97
98BEGIN
99     TEST ("CD2A51A", "CHECK THAT WHEN A SIZE SPECICFICATION IS " &
100                      "GIVEN FOR A FIXED POINT TYPE, THEN " &
101                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
102                      "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
103
104     PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
105
106     IF IDENT (CZERO) /= 0.0 THEN
107          FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
108     END IF;
109
110     IF CHECK_TYPE'LAST < IDENT (3.9375) THEN
111          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
112     END IF;
113
114     IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
115          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
116     END IF;
117
118     IF CHECK_TYPE'AFT /= BASIC_TYPE'AFT THEN
119          FAILED ("INCORRECT VALUE FOR CHECK_TYPE'AFT");
120     END IF;
121
122     IF CNEG1'SIZE < IDENT_INT (BASIC_SIZE) THEN
123          FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
124     END IF;
125
126     IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
127        CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
128          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 2");
129     END IF;
130
131     IF CHECK_TYPE (CNEG1 * IDENT (CPOS1)) NOT IN -2.4375 .. -2.1875 OR
132        CHECK_TYPE (IDENT (CNEG2) / CPOS2) NOT IN
133               -0.125 .. -0.0625 THEN
134          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 2");
135     END IF;
136
137     IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
138            CNEG2 IN -0.25 .. 0.0 OR
139            IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
140          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
141                  "OPERATORS - 2");
142     END IF;
143
144     IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
145          FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
146     END IF;
147
148     IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
149        IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
150          FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 3");
151     END IF;
152
153     IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
154        IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
155          FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
156                  "OPERATORS - 3");
157     END IF;
158
159     IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
160            CHARRAY (1) IN -0.25 .. 0.0 OR
161            IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
162          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
163                  "OPERATORS - 3");
164     END IF;
165
166     IF CHREC.COMPP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
167          FAILED ("INCORRECT VALUE FOR CHREC.COMPP1'SIZE");
168     END IF;
169
170     IF IDENT (CHREC.COMPN1) + CHREC.COMPP1 NOT IN
171             -2.875 .. -2.8125 OR
172        CHREC.COMPP2  - IDENT (CHREC.COMPP1) NOT IN
173             2.8125 .. 2.875 THEN
174          FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 4");
175     END IF;
176
177     IF CHECK_TYPE (CHREC.COMPN1 * IDENT (CHREC.COMPP1)) NOT IN
178          -2.4375 .. -2.1875 OR
179        CHECK_TYPE (IDENT (CHREC.COMPN2) / CHREC.COMPP2) NOT IN
180          -0.125 .. -0.0625 THEN
181          FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 4");
182     END IF;
183
184     IF IDENT (CHREC.COMPP1) NOT IN 0.625 .. 0.6875 OR
185            CHREC.COMPN2 IN -0.25 .. 0.0 OR
186            IDENT (CHREC.COMPN2) IN -1.0 .. -0.4375 THEN
187          FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
188                  "OPERATORS - 4");
189     END IF;
190
191     RESULT;
192
193END CD2A51A;
194