1-- CC1222A.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-- FOR A FORMAL FLOATING POINT TYPE, CHECK THAT THE FOLLOWING BASIC 26-- OPERATIONS ARE IMPLICITLY DECLARED AND ARE THEREFORE AVAILABLE 27-- WITHIN THE GENERIC UNIT: ASSIGNMENT, MEMBERSHIP TESTS, 28-- QUALIFICATION, EXPLICIT CONVERSION TO AND FROM OTHER NUMERIC TYPES, 29-- AND REAL LITERALS (IMPLICIT CONVERSION FROM UNIVERSAL REAL TO THE 30-- FORMAL TYPE), 'FIRST, 'LAST, 'SIZE, 'ADDRESS, 'DIGITS, 'MACHINE_RADIX, 31-- 'MACHINE_MANTISSA, 'MACHINE_EMAX, 'MACHINE_EMIN, 'MACHINE_ROUNDS, 32-- 'MACHINE_OVERFLOWS. 33 34-- R.WILLIAMS 9/30/86 35-- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X. 36 37WITH REPORT; USE REPORT; 38WITH SYSTEM; USE SYSTEM; 39PROCEDURE CC1222A IS 40 41 TYPE NEWFLT IS NEW FLOAT; 42 43BEGIN 44 TEST ( "CC1222A", "FOR A FORMAL FLOATING POINT TYPE, CHECK " & 45 "THAT THE BASIC OPERATIONS ARE " & 46 "IMPLICITLY DECLARED AND ARE THEREFORE " & 47 "AVAILABLE WITHIN THE GENERIC UNIT" ); 48 49 DECLARE -- (A). CHECKS FOR ASSIGNMENT, MEMBERSHIP TESTS AND 50 -- QUALIFICATION. 51 52 GENERIC 53 TYPE T IS DIGITS <>; 54 TYPE T1 IS DIGITS <>; 55 F : T; 56 F1 : T1; 57 PROCEDURE P (F2 : T; STR : STRING); 58 59 PROCEDURE P (F2 : T; STR : STRING) IS 60 SUBTYPE ST IS T RANGE -1.0 .. 1.0; 61 F3, F4 : T; 62 63 FUNCTION FUN (X : T) RETURN BOOLEAN IS 64 BEGIN 65 RETURN IDENT_BOOL (TRUE); 66 END FUN; 67 68 FUNCTION FUN (X : T1) RETURN BOOLEAN IS 69 BEGIN 70 RETURN IDENT_BOOL (FALSE); 71 END FUN; 72 73 BEGIN 74 F3 := F; 75 F4 := F2; 76 F3 := F4; 77 78 IF F3 /= F2 THEN 79 FAILED ( "INCORRECT RESULTS FOR ASSIGNMENT " & 80 "WITH TYPE - " & STR); 81 END IF; 82 83 IF F IN ST THEN 84 NULL; 85 ELSE 86 FAILED ( "INCORRECT RESULTS FOR ""IN"" WITH " & 87 "TYPE - " & STR); 88 END IF; 89 90 IF F2 NOT IN ST THEN 91 NULL; 92 ELSE 93 FAILED ( "INCORRECT RESULTS FOR ""NOT IN"" WITH " & 94 "TYPE - " & STR); 95 END IF; 96 97 IF T'(F) /= F THEN 98 FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " & 99 "WITH TYPE - " & STR & " - 1" ); 100 END IF; 101 102 IF FUN (T'(1.0)) THEN 103 NULL; 104 ELSE 105 FAILED ( "INCORRECT RESULTS FOR QUALIFICATION " & 106 "WITH TYPE - " & STR & " - 2" ); 107 END IF; 108 109 END P; 110 111 PROCEDURE P1 IS NEW P (FLOAT, FLOAT, 0.0, 0.0); 112 PROCEDURE P2 IS NEW P (NEWFLT, NEWFLT, 0.0, 0.0); 113 114 BEGIN 115 P1 (2.0, "FLOAT"); 116 P2 (2.0, "NEWFLT"); 117 END; -- (A). 118 119 DECLARE -- (B) CHECKS FOR EXPLICIT CONVERSION TO AND FROM OTHER 120 -- NUMERIC TYPES, AND IMPLICIT CONVERSION FROM 121 -- REAL LITERAL. 122 123 GENERIC 124 TYPE T IS DIGITS <>; 125 PROCEDURE P (STR : STRING); 126 127 PROCEDURE P (STR : STRING) IS 128 129 TYPE FIXED IS DELTA 0.1 RANGE -100.0 .. 100.0; 130 FI0 : FIXED := 0.0; 131 FI2 : FIXED := 2.0; 132 FIN2 : FIXED := -2.0; 133 134 I0 : INTEGER := 0; 135 I2 : INTEGER := 2; 136 IN2 : INTEGER := -2; 137 138 T0 : T := 0.0; 139 T2 : T := 2.0; 140 TN2 : T := -2.0; 141 142 FUNCTION IDENT (X : T) RETURN T IS 143 BEGIN 144 IF EQUAL (3, 3) THEN 145 RETURN X; 146 ELSE 147 RETURN T'FIRST; 148 END IF; 149 END IDENT; 150 151 BEGIN 152 IF T0 + 1.0 /= 1.0 THEN 153 FAILED ( "INCORRECT RESULTS FOR IMPLICIT " & 154 "CONVERSION WITH TYPE " & STR & " - 1" ); 155 END IF; 156 157 IF T2 + 1.0 /= 3.0 THEN 158 FAILED ( "INCORRECT RESULTS FOR IMPLICIT " & 159 "CONVERSION WITH TYPE " & STR & " - 2" ); 160 END IF; 161 162 IF TN2 + 1.0 /= -1.0 THEN 163 FAILED ( "INCORRECT RESULTS FOR IMPLICIT " & 164 "CONVERSION WITH TYPE " & STR & " - 3" ); 165 END IF; 166 167 IF T (FI0) /= T0 THEN 168 FAILED ( "INCORRECT CONVERSION FROM " & 169 "FIXED VALUE 0.0 WITH TYPE " & STR); 170 END IF; 171 172 IF T (FI2) /= IDENT (T2) THEN 173 FAILED ( "INCORRECT CONVERSION FROM " & 174 "FIXED VALUE 2.0 WITH TYPE " & STR); 175 END IF; 176 177 IF T (FIN2) /= TN2 THEN 178 FAILED ( "INCORRECT CONVERSION FROM " & 179 "FIXED VALUE -2.0 WITH TYPE " & STR); 180 END IF; 181 182 IF T (I0) /= IDENT (T0) THEN 183 FAILED ( "INCORRECT CONVERSION FROM " & 184 "INTEGER VALUE 0 WITH TYPE " & STR); 185 END IF; 186 187 IF T (I2) /= T2 THEN 188 FAILED ( "INCORRECT CONVERSION FROM " & 189 "INTEGER VALUE 2 WITH TYPE " & STR); 190 END IF; 191 192 IF T (IN2) /= IDENT (TN2) THEN 193 FAILED ( "INCORRECT CONVERSION FROM " & 194 "INTEGER VALUE -2 WITH TYPE " & STR); 195 END IF; 196 197 IF FIXED (T0) /= FI0 THEN 198 FAILED ( "INCORRECT CONVERSION TO " & 199 "FIXED VALUE 0.0 WITH TYPE " & STR); 200 END IF; 201 202 IF FIXED (IDENT (T2)) /= FI2 THEN 203 FAILED ( "INCORRECT CONVERSION TO " & 204 "FIXED VALUE 2.0 WITH TYPE " & STR); 205 END IF; 206 207 IF FIXED (TN2) /= FIN2 THEN 208 FAILED ( "INCORRECT CONVERSION TO " & 209 "FIXED VALUE -2.0 WITH TYPE " & STR); 210 END IF; 211 212 IF INTEGER (IDENT (T0)) /= I0 THEN 213 FAILED ( "INCORRECT CONVERSION TO " & 214 "INTEGER VALUE 0 WITH TYPE " & STR); 215 END IF; 216 217 IF INTEGER (T2) /= I2 THEN 218 FAILED ( "INCORRECT CONVERSION TO " & 219 "INTEGER VALUE 2 WITH TYPE " & STR); 220 END IF; 221 222 IF INTEGER (IDENT (TN2)) /= IN2 THEN 223 FAILED ( "INCORRECT CONVERSION TO " & 224 "INTEGER VALUE -2 WITH TYPE " & STR); 225 END IF; 226 227 END P; 228 229 PROCEDURE P1 IS NEW P (FLOAT); 230 PROCEDURE P2 IS NEW P (NEWFLT); 231 232 BEGIN 233 P1 ( "FLOAT" ); 234 P2 ( "NEWFLT" ); 235 END; -- (B). 236 237 DECLARE -- (C) CHECKS FOR ATTRIBUTES. 238 239 GENERIC 240 TYPE T IS DIGITS <>; 241 F, L : T; 242 D : INTEGER; 243 PROCEDURE P (STR : STRING); 244 245 PROCEDURE P (STR : STRING) IS 246 247 F1 : T; 248 A : ADDRESS := F'ADDRESS; 249 S : INTEGER := F'SIZE; 250 251 I : INTEGER; 252 I1 : INTEGER := T'MACHINE_RADIX; 253 I2 : INTEGER := T'MACHINE_MANTISSA; 254 I3 : INTEGER := T'MACHINE_EMAX; 255 I4 : INTEGER := T'MACHINE_EMIN; 256 257 B1 : BOOLEAN := T'MACHINE_ROUNDS; 258 B2 : BOOLEAN := T'MACHINE_OVERFLOWS; 259 260 BEGIN 261 IF T'DIGITS /= D THEN 262 FAILED ( "INCORRECT VALUE FOR " & 263 STR & "'DIGITS" ); 264 END IF; 265 266 IF T'FIRST /= F THEN 267 FAILED ( "INCORRECT VALUE FOR " & 268 STR & "'FIRST" ); 269 END IF; 270 271 IF T'LAST /= L THEN 272 FAILED ( "INCORRECT VALUE FOR " & 273 STR & "'LAST" ); 274 END IF; 275 276 END P; 277 278 PROCEDURE P1 IS 279 NEW P (FLOAT, FLOAT'FIRST, FLOAT'LAST, FLOAT'DIGITS); 280 PROCEDURE P2 IS 281 NEW P (NEWFLT, NEWFLT'FIRST, NEWFLT'LAST, 282 NEWFLT'DIGITS); 283 284 BEGIN 285 P1 ( "FLOAT" ); 286 P2 ( "NEWFLT" ); 287 END; -- (C). 288 289 RESULT; 290END CC1222A; 291