1-- CE3704F.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 INTEGER_IO GET DOES NOT ALLOW EMBEDDED BLANKS OR 27-- CONSECUTIVE UNDERSCORES TO BE INPUT. 28 29-- APPLICABILITY CRITERIA: 30-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH 31-- SUPPORT TEXT FILES. 32 33-- HISTORY: 34-- SPS 10/04/82 35-- VKG 01/14/83 36-- CPP 07/30/84 37-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE 38-- RESULT WHEN FILES ARE NOT SUPPORTED. 39-- DWC 09/10/87 REMOVED UNNECESSARY CODE, CORRECTED EXCEPTION 40-- HANDLING, AND ADDED MORE CHECKS OF THE VALUES 41-- OF CHARACTERS READ. 42 43WITH REPORT; USE REPORT; 44WITH TEXT_IO; USE TEXT_IO; 45 46PROCEDURE CE3704F IS 47 INCOMPLETE : EXCEPTION; 48 49BEGIN 50 51 TEST ("CE3704F", "INTEGER_IO GET DOES NOT ALLOW EMBEDDED " & 52 "BLANKS OR CONSECUTIVE UNDERSCORES"); 53 54 DECLARE 55 FT : FILE_TYPE; 56 X : INTEGER; 57 PACKAGE IIO IS NEW INTEGER_IO (INTEGER); 58 USE IIO; 59 CH : CHARACTER; 60 P : POSITIVE; 61 BEGIN 62 63-- CREATE AND INITIALIZE FILE 64 65 BEGIN 66 CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); 67 EXCEPTION 68 WHEN USE_ERROR => 69 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & 70 "WITH OUT_FILE MODE"); 71 RAISE INCOMPLETE; 72 WHEN NAME_ERROR => 73 NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & 74 "WITH OUT_FILE MODE"); 75 RAISE INCOMPLETE; 76 END; 77 78 PUT (FT, "12_345"); 79 NEW_LINE (FT); 80 PUT (FT, "12 345"); 81 NEW_LINE (FT); 82 PUT (FT, "1__345"); 83 NEW_LINE (FT); 84 PUT (FT, "-56"); 85 NEW_LINE (FT); 86 PUT (FT, "10E0"); 87 NEW_LINE (FT); 88 PUT (FT, "10E-2X"); 89 NEW_LINE (FT); 90 PUT (FT, "4E1__2"); 91 NEW_LINE (FT); 92 PUT (FT, "1 0#99#"); 93 NEW_LINE (FT); 94 PUT (FT, "1__0#99#"); 95 NEW_LINE (FT); 96 PUT (FT, "10#9_9#"); 97 NEW_LINE (FT); 98 PUT (FT, "10#9__9#"); 99 NEW_LINE (FT); 100 PUT (FT, "10#9 9#"); 101 NEW_LINE (FT); 102 PUT (FT, "16#E#E1"); 103 NEW_LINE (FT); 104 PUT (FT, "2#110#E1_1"); 105 NEW_LINE (FT); 106 PUT (FT, "2#110#E1__1"); 107 CLOSE(FT); 108 109-- BEGIN TEST 110 111 BEGIN 112 OPEN (FT, IN_FILE, LEGAL_FILE_NAME); 113 EXCEPTION 114 WHEN USE_ERROR => 115 NOT_APPLICABLE ("USE_ERROR RAISED; " & 116 "TEXT OPEN WITH IN_FILE " & 117 "MODE"); 118 RAISE INCOMPLETE; 119 END; 120 121 GET (FT, X); 122 IF X /= 12345 THEN 123 FAILED ("GET WITH UNDERSCORE INCORRECT - (1)"); 124 END IF; 125 126 SKIP_LINE (FT); 127 128 BEGIN 129 GET (FT, X, 6); 130 FAILED ("DATA_ERROR NOT RAISED - (2)"); 131 EXCEPTION 132 WHEN DATA_ERROR => 133 NULL; 134 WHEN OTHERS => 135 FAILED ("WRONG EXCEPTION RAISED - (2)"); 136 END; 137 138 SKIP_LINE (FT); 139 140 BEGIN 141 GET (FT, X); 142 FAILED ("DATA_ERROR NOT RAISED - (3)"); 143 EXCEPTION 144 WHEN DATA_ERROR => 145 NULL; 146 WHEN OTHERS => 147 FAILED ("WRONG EXCEPTION RAISED - (3)"); 148 END; 149 150 IF END_OF_LINE (FT) THEN 151 FAILED ("GET STOPPED AT END OF LINE - (3)"); 152 ELSE 153 GET (FT, CH); 154 IF CH /= '_' THEN 155 FAILED ("GET STOPPED AT WRONG POSITION - " & 156 "(3): CHAR IS " & CH); 157 END IF; 158 GET (FT, CH); 159 IF CH /= '3' THEN 160 FAILED ("GET STOPPED AT WRONG POSITION - " & 161 "(3.5): CHAR IS " & CH); 162 END IF; 163 END IF; 164 165 SKIP_LINE (FT); 166 GET (FT, X); 167 IF X /= (-56) THEN 168 FAILED ("GET WITH GOOD CASE INCORRECT - (4)"); 169 END IF; 170 171 SKIP_LINE (FT); 172 GET (FT, X, 4); 173 IF X /= 10 THEN 174 FAILED ("GET WITH ZERO EXPONENT INCORRECT - (5)"); 175 END IF; 176 177 SKIP_LINE (FT); 178 179 BEGIN 180 GET (FT, X); 181 FAILED ("DATA_ERROR NOT RAISED - (6)"); 182 EXCEPTION 183 WHEN DATA_ERROR => 184 NULL; 185 WHEN OTHERS => 186 FAILED ("WRONG EXCEPTION RAISED - (6)"); 187 END; 188 189 IF END_OF_LINE (FT) THEN 190 FAILED ("GET STOPPED AT END OF LINE - (6)"); 191 ELSE 192 GET (FT, CH); 193 IF CH /= 'X' THEN 194 FAILED ("GET STOPPED AT WRONG POSITION - " & 195 "(6): CHAR IS " & CH); 196 END IF; 197 END IF; 198 199 SKIP_LINE (FT); 200 201 BEGIN 202 GET (FT, X); 203 FAILED ("DATA_ERROR NOT RAISED - (7)"); 204 EXCEPTION 205 WHEN DATA_ERROR => 206 NULL; 207 WHEN OTHERS => 208 FAILED ("WRONG EXCEPTION RAISED - (7)"); 209 END; 210 211 IF END_OF_LINE (FT) THEN 212 FAILED ("GET STOPPED AT END OF LINE - (7)"); 213 ELSE 214 GET (FT, CH); 215 IF CH /= '_' THEN 216 FAILED ("GET STOPPED AT WRONG POSITION - " & 217 "(7): CHAR IS " & CH); 218 END IF; 219 GET (FT, CH); 220 IF CH /= '2' THEN 221 FAILED ("GET STOPPED AT WRONG POSITION - " & 222 "(7.5): CHAR IS " & CH); 223 END IF; 224 END IF; 225 226 SKIP_LINE (FT); 227 228 BEGIN 229 GET (FT, X, 7); 230 FAILED ("DATA_ERROR NOT RAISED - (8)"); 231 EXCEPTION 232 WHEN DATA_ERROR => 233 NULL; 234 WHEN OTHERS => 235 FAILED ("WRONG EXCEPTION RAISED - (8)"); 236 END; 237 238 SKIP_LINE (FT); 239 240 BEGIN 241 GET (FT, X); 242 FAILED ("DATA_ERROR NOT RAISED - (9)"); 243 EXCEPTION 244 WHEN DATA_ERROR => 245 NULL; 246 WHEN OTHERS => 247 FAILED ("WRONG EXCEPTION RAISED - (9)"); 248 END; 249 250 IF END_OF_LINE (FT) THEN 251 FAILED ("GET STOPPED AT END OF LINE - (9)"); 252 ELSE 253 GET (FT, CH); 254 IF CH /= '_' THEN 255 FAILED ("GET STOPPED AT WRONG POSITION " & 256 "- (9): CHAR IS " & CH); 257 END IF; 258 GET (FT, CH); 259 IF CH /= '0' THEN 260 FAILED ("GET STOPPED AT WRONG POSITION " & 261 "- (9.5): CHAR IS " & CH); 262 END IF; 263 END IF; 264 265 SKIP_LINE (FT); 266 GET (FT, X); 267 IF X /= 99 THEN 268 FAILED ("GET WITH UNDERSCORE IN " & 269 "BASED LITERAL INCORRECT - (10)"); 270 END IF; 271 272 SKIP_LINE (FT); 273 274 BEGIN 275 GET (FT, X); 276 FAILED ("DATA_ERROR NOT RAISED - (11)"); 277 EXCEPTION 278 WHEN DATA_ERROR => 279 NULL; 280 WHEN OTHERS => 281 FAILED ("WRONG EXCEPTION RAISED - (11)"); 282 END; 283 284 IF END_OF_LINE (FT) THEN 285 FAILED ("GET STOPPED AT END OF LINE - (11)"); 286 ELSE 287 GET (FT, CH); 288 IF CH /= '_' THEN 289 FAILED ("GET STOPPED AT WRONG POSITION - " & 290 "(11): CHAR IS " & CH); 291 END IF; 292 GET (FT, CH); 293 IF CH /= '9' THEN 294 FAILED ("GET STOPPED AT WRONG POSITION - " & 295 "(11.5): CHAR IS " & CH); 296 END IF; 297 END IF; 298 299 SKIP_LINE (FT); 300 301 BEGIN 302 GET (FT, X, 6); 303 FAILED ("DATA_ERROR NOT RAISED - (12)"); 304 EXCEPTION 305 WHEN DATA_ERROR => 306 NULL; 307 WHEN OTHERS => 308 FAILED ("WRONG EXCEPTION RAISED - (12)"); 309 END; 310 311 SKIP_LINE (FT); 312 GET (FT, X, 7); 313 IF X /= 224 THEN 314 FAILED ("GET WITH GOOD CASE OF " & 315 "BASED LITERAL INCORRECT - (13)"); 316 END IF; 317 318 SKIP_LINE (FT); 319 GET (FT, X, 10); 320 IF X /= (6 * 2 ** 11) THEN 321 FAILED ("GET WITH UNDERSCORE IN EXPONENT" & 322 "OF BASED LITERAL INCORRECT - (14)"); 323 END IF; 324 325 SKIP_LINE (FT); 326 327 BEGIN 328 GET (FT, X); 329 FAILED ("DATA_ERROR NOT RAISED - (15)"); 330 EXCEPTION 331 WHEN DATA_ERROR => 332 NULL; 333 WHEN OTHERS => 334 FAILED ("WRONG EXCEPTION RAISED - (15)"); 335 END; 336 337 IF END_OF_LINE (FT) THEN 338 FAILED ("GET STOPPED AT END OF LINE - (15)"); 339 ELSE 340 GET (FT, CH); 341 IF CH /= '_' THEN 342 FAILED ("GET STOPPED AT WRONG POSITION - " & 343 "(15): CHAR IS " & CH); 344 END IF; 345 GET (FT, CH); 346 IF CH /= '1' THEN 347 FAILED ("GET STOPPED AT WRONG POSITION - " & 348 "(15.5): CHAR IS " & CH); 349 END IF; 350 END IF; 351 352 BEGIN 353 DELETE (FT); 354 EXCEPTION 355 WHEN USE_ERROR => 356 NULL; 357 END; 358 EXCEPTION 359 WHEN INCOMPLETE => 360 NULL; 361 END; 362 363 RESULT; 364 365END CE3704F; 366