1-- CD2A53E.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 SIZE AND SMALL SPECIFICATIONS ARE GIVEN FOR A
27--     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
28--     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE WHEN THE TYPE
29--     IS PASSED AS A GENERIC ACTUAL PARAMETER.
30
31-- HISTORY:
32--     BCB 08/24/87  CREATED ORIGINAL TEST.
33--     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND CHANGED
34--                   OPERATORS ON 'SIZE TESTS.
35--     WMC 04/01/92  ELIMINATED TEST REDUNDANCIES.
36--     MRM 07/16/92  FIX ALIGNMENT OF BLOCK BODY
37--     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
38
39WITH REPORT; USE REPORT;
40PROCEDURE CD2A53E IS
41
42     BASIC_SIZE : CONSTANT := INTEGER'SIZE/2;
43     BASIC_SMALL : CONSTANT := 2.0 ** (-4);
44     B : BOOLEAN;
45
46     TYPE CHECK_TYPE IS DELTA 1.0 RANGE -4.0 .. 4.0;
47     FOR CHECK_TYPE'SMALL USE BASIC_SMALL;
48     FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
49
50BEGIN
51
52     TEST ("CD2A53E", "CHECK THAT WHEN SIZE AND SMALL SPECIFICATIONS " &
53                      "ARE GIVEN FOR A FIXED POINT TYPE, THEN " &
54                      "OPERATIONS ON VALUES OF SUCH A TYPE ARE NOT " &
55                      "AFFECTED BY THE REPRESENTATION CLAUSE WHEN " &
56                      "THE TYPE IS PASSED AS A GENERIC ACTUAL " &
57                      "PARAMETER");
58
59     DECLARE
60
61          GENERIC
62
63               TYPE FIXED_ELEMENT IS DELTA <>;
64
65          FUNCTION FUNC RETURN BOOLEAN;
66
67          FUNCTION FUNC RETURN BOOLEAN IS
68
69               ZERO  : CONSTANT :=  0.0;
70
71               TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
72
73               CNEG1 : FIXED_ELEMENT := -3.5;
74               CNEG2 : FIXED_ELEMENT := FIXED_ELEMENT (-1.0/3.0);
75               CPOS1 : FIXED_ELEMENT := FIXED_ELEMENT (4.0/6.0);
76               CPOS2 : FIXED_ELEMENT :=  3.5;
77               CZERO : FIXED_ELEMENT;
78
79               TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF FIXED_ELEMENT;
80               CHARRAY : ARRAY_TYPE :=
81                   (-3.5, FIXED_ELEMENT (-1.0/3.0), FIXED_ELEMENT
82                    (4.0/6.0), 3.5);
83
84               TYPE REC_TYPE IS RECORD
85                    COMPF : FIXED_ELEMENT := -3.5;
86                    COMPN : FIXED_ELEMENT := FIXED_ELEMENT (-1.0/3.0);
87                    COMPP : FIXED_ELEMENT := FIXED_ELEMENT (4.0/6.0);
88                    COMPL : FIXED_ELEMENT :=  3.5;
89               END RECORD;
90
91               CHREC : REC_TYPE;
92
93               FUNCTION IDENT (FX : FIXED_ELEMENT) RETURN
94                    FIXED_ELEMENT IS
95               BEGIN
96                    IF EQUAL (3, 3) THEN
97                         RETURN FX;
98                    ELSE
99                         RETURN 0.0;
100                    END IF;
101               END IDENT;
102
103               PROCEDURE PROC (CN1IN, CP1IN      :        FIXED_ELEMENT;
104                               CN2INOUT,CP2INOUT : IN OUT FIXED_ELEMENT;
105                               CZOUT             :    OUT FIXED_ELEMENT)
106                               IS
107               BEGIN
108
109                    IF +IDENT (CN2INOUT) NOT IN -0.375 .. -0.3125 OR
110                        IDENT (-CP1IN) NOT IN -0.6875 .. -0.625 THEN
111                        FAILED ("INCORRECT RESULTS FOR " &
112                                "UNARY ADDING OPERATORS - 1");
113                    END IF;
114
115                    IF ABS IDENT (CN2INOUT) NOT IN 0.3125 .. 0.375 OR
116                         IDENT (ABS CP1IN) NOT IN 0.625 .. 0.6875 THEN
117                         FAILED ("INCORRECT RESULTS FOR " &
118                                 "ABSOLUTE VALUE OPERATORS - 1");
119                    END IF;
120
121                    CZOUT := 0.0;
122
123               END PROC;
124
125          BEGIN -- FUNC
126
127               PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
128
129               IF IDENT (CZERO) /= ZERO THEN
130                    FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
131               END IF;
132
133               IF FIXED_ELEMENT'LAST < IDENT (3.9375) THEN
134                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'LAST");
135               END IF;
136
137               IF FIXED_ELEMENT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
138                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'SIZE");
139               END IF;
140
141               IF FIXED_ELEMENT'SMALL /= BASIC_SMALL THEN
142                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'SMALL");
143               END IF;
144
145               IF FIXED_ELEMENT'AFT /= 1 THEN
146                    FAILED ("INCORRECT VALUE FOR FIXED_ELEMENT'AFT");
147               END IF;
148
149               IF CNEG1'SIZE < IDENT_INT(BASIC_SIZE) THEN
150                    FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
151               END IF;
152
153               IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
154                   CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
155                    FAILED ("INCORRECT RESULTS FOR BINARY ADDING " &
156                            "OPERATORS - 2");
157               END IF;
158
159               IF FIXED_ELEMENT (CNEG1 * IDENT (CPOS1)) NOT IN
160                    -2.4375 .. -2.1875 OR
161                  FIXED_ELEMENT (IDENT (CNEG2) / CPOS2) NOT IN
162                    -0.125 .. -0.0625 THEN
163                    FAILED ("INCORRECT RESULTS FOR MULTIPLYING " &
164                            "OPERATORS - 2");
165               END IF;
166
167               IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
168                      CNEG2 IN -0.25 .. 0.0 OR
169                      IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
170                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
171                            "OPERATORS - 2");
172               END IF;
173
174               IF CHARRAY(1)'SIZE < IDENT_INT(BASIC_SIZE) THEN
175                    FAILED ("INCORRECT VALUE FOR CHARRAY(1)'SIZE");
176               END IF;
177
178               IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
179                    IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
180                    FAILED ("INCORRECT RESULTS FOR UNARY ADDING " &
181                            "OPERATORS - 3");
182               END IF;
183
184               IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
185                  IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
186                    FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
187                            "OPERATORS - 3");
188               END IF;
189
190               IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
191                      CHARRAY (1) IN -0.25 .. 0.0 OR
192                      IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
193                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
194                            "OPERATORS - 3");
195               END IF;
196
197               IF CHREC.COMPP'SIZE < IDENT_INT(BASIC_SIZE) THEN
198                    FAILED ("INCORRECT VALUE FOR CHREC.COMPP'SIZE");
199               END IF;
200
201               IF IDENT (CHREC.COMPF) + CHREC.COMPP NOT IN
202                     -2.875 .. -2.8125 OR
203                    CHREC.COMPL  - IDENT (CHREC.COMPP) NOT IN
204                     2.8125 .. 2.875 THEN
205                    FAILED ("INCORRECT RESULTS FOR BINARY ADDING " &
206                               "OPERATORS - 4");
207               END IF;
208
209               IF FIXED_ELEMENT (CHREC.COMPF * IDENT (CHREC.COMPP))
210                    NOT IN -2.4375 .. -2.1875 OR
211                  FIXED_ELEMENT (IDENT (CHREC.COMPN) / CHREC.COMPL)
212                    NOT IN -0.125 .. -0.0625 THEN
213                    FAILED ("INCORRECT RESULTS FOR MULTIPLYING " &
214                            "OPERATORS - 4");
215               END IF;
216
217               IF IDENT (CHREC.COMPP) NOT IN 0.625 .. 0.6875 OR
218                      CHREC.COMPN IN -0.25 .. 0.0 OR
219                      IDENT (CHREC.COMPN) IN -1.0 .. -0.4375 THEN
220                    FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
221                            "OPERATORS - 4");
222               END IF;
223
224               RETURN TRUE;
225
226          END FUNC;
227
228          FUNCTION NEWFUNC IS NEW FUNC(CHECK_TYPE);
229     BEGIN
230          B := NEWFUNC;
231     END;
232
233     RESULT;
234
235END CD2A53E;
236