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