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