1-- CE2401A.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 READ (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH 27-- AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE AND 28-- END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPES 29-- STRING, CHARACTER, AND INTEGER. 30 31-- APPLICABILITY CRITERIA: 32-- THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH 33-- SUPPORT DIRECT FILES. 34 35-- HISTORY: 36-- ABW 08/16/82 37-- SPS 09/15/82 38-- SPS 11/09/82 39-- JBG 02/22/84 CHANGE TO .ADA TEST. 40-- EG 05/16/85 41-- TBN 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE 42-- RESULT WHEN FILES ARE NOT SUPPORTED. 43-- DWC 07/31/87 ISOLATED EXCEPTIONS. 44 45WITH REPORT; USE REPORT; 46WITH DIRECT_IO; 47 48PROCEDURE CE2401A IS 49 END_SUBTEST : EXCEPTION; 50BEGIN 51 52 TEST ("CE2401A" , "CHECK THAT READ, WRITE, SET_INDEX " & 53 "INDEX, SIZE AND END_OF_FILE ARE " & 54 "SUPPORTED FOR DIRECT FILES"); 55 56 DECLARE 57 SUBTYPE STR_TYPE IS STRING (1..12); 58 PACKAGE DIR_STR IS NEW DIRECT_IO (STR_TYPE); 59 USE DIR_STR; 60 FILE_STR : FILE_TYPE; 61 BEGIN 62 BEGIN 63 CREATE (FILE_STR, INOUT_FILE, LEGAL_FILE_NAME); 64 EXCEPTION 65 WHEN USE_ERROR | NAME_ERROR => 66 NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & 67 "ON CREATE - STRING"); 68 RAISE END_SUBTEST; 69 WHEN OTHERS => 70 FAILED ("UNEXPECTED ERROR RAISED ON " & 71 "CREATE - STRING"); 72 RAISE END_SUBTEST; 73 END; 74 75 DECLARE 76 STR : STR_TYPE := "TEXT OF FILE"; 77 ITEM_STR : STR_TYPE; 78 ONE_STR : POSITIVE_COUNT := 1; 79 TWO_STR : POSITIVE_COUNT := 2; 80 BEGIN 81 BEGIN 82 WRITE (FILE_STR,STR); 83 EXCEPTION 84 WHEN OTHERS => 85 FAILED ("EXCEPTION RAISED ON WRITE FOR " & 86 "STRING - 1"); 87 END; 88 89 BEGIN 90 WRITE (FILE_STR,STR,TWO_STR); 91 EXCEPTION 92 WHEN OTHERS => 93 FAILED ("EXCEPTION RAISED ON WRITE FOR " & 94 "STRING - 2"); 95 END; 96 97 BEGIN 98 IF SIZE (FILE_STR) /= TWO_STR THEN 99 FAILED ("SIZE FOR TYPE STRING"); 100 END IF; 101 IF NOT END_OF_FILE (FILE_STR) THEN 102 FAILED ("WRONG END_OF_FILE VALUE FOR STRING"); 103 END IF; 104 SET_INDEX (FILE_STR,ONE_STR); 105 IF INDEX (FILE_STR) /= ONE_STR THEN 106 FAILED ("WRONG INDEX VALUE FOR STRING"); 107 END IF; 108 END; 109 110 CLOSE (FILE_STR); 111 112 BEGIN 113 OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME); 114 EXCEPTION 115 WHEN USE_ERROR => 116 NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & 117 "NOT SUPPORTED - 1"); 118 RAISE END_SUBTEST; 119 END; 120 121 BEGIN 122 READ (FILE_STR,ITEM_STR); 123 IF ITEM_STR /= STR THEN 124 FAILED ("INCORRECT STRING VALUE READ - 1"); 125 END IF; 126 EXCEPTION 127 WHEN OTHERS => 128 FAILED ("READ WITHOUT FROM FOR STRING"); 129 END; 130 131 BEGIN 132 READ (FILE_STR,ITEM_STR,ONE_STR); 133 IF ITEM_STR /= STR THEN 134 FAILED ("INCORRECT STRING VALUE READ - 2"); 135 END IF; 136 EXCEPTION 137 WHEN OTHERS => 138 FAILED ("READ WITH FROM FOR STRING"); 139 END; 140 END; 141 142 BEGIN 143 DELETE (FILE_STR); 144 EXCEPTION 145 WHEN USE_ERROR => 146 NULL; 147 END; 148 149 EXCEPTION 150 WHEN END_SUBTEST => 151 NULL; 152 END; 153 154 DECLARE 155 PACKAGE DIR_CHR IS NEW DIRECT_IO (CHARACTER); 156 USE DIR_CHR; 157 FILE_CHR : FILE_TYPE; 158 BEGIN 159 BEGIN 160 CREATE (FILE_CHR, INOUT_FILE, LEGAL_FILE_NAME(2)); 161 EXCEPTION 162 WHEN USE_ERROR | NAME_ERROR => 163 NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & 164 "ON CREATE - CHARACTER"); 165 RAISE END_SUBTEST; 166 WHEN OTHERS => 167 FAILED ("UNEXPECTED ERROR RAISED ON " & 168 "CREATE - CHARACTER"); 169 RAISE END_SUBTEST; 170 END; 171 172 DECLARE 173 CHR : CHARACTER := 'C'; 174 ITEM_CHR : CHARACTER; 175 ONE_CHR : POSITIVE_COUNT := 1; 176 TWO_CHR : POSITIVE_COUNT := 2; 177 BEGIN 178 BEGIN 179 WRITE (FILE_CHR,CHR); 180 EXCEPTION 181 WHEN OTHERS => 182 FAILED ("EXCEPTION RAISED ON WRITE FOR " & 183 "CHARACTER - 1"); 184 END; 185 186 BEGIN 187 WRITE (FILE_CHR,CHR,TWO_CHR); 188 EXCEPTION 189 WHEN OTHERS => 190 FAILED ("EXCEPTION RAISED ON WRITE FOR " & 191 "CHARACTER - 2"); 192 END; 193 194 BEGIN 195 IF SIZE (FILE_CHR) /= TWO_CHR THEN 196 FAILED ("SIZE FOR TYPE CHARACTER"); 197 END IF; 198 IF NOT END_OF_FILE (FILE_CHR) THEN 199 FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " & 200 "CHARACTER"); 201 END IF; 202 SET_INDEX (FILE_CHR,ONE_CHR); 203 IF INDEX (FILE_CHR) /= ONE_CHR THEN 204 FAILED ("WRONG INDEX VALUE FOR TYPE " & 205 "CHARACTER"); 206 END IF; 207 END; 208 209 CLOSE (FILE_CHR); 210 211 BEGIN 212 OPEN (FILE_CHR, IN_FILE, LEGAL_FILE_NAME(2)); 213 EXCEPTION 214 WHEN USE_ERROR => 215 NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & 216 "NOT SUPPORTED - 2"); 217 RAISE END_SUBTEST; 218 END; 219 220 BEGIN 221 READ (FILE_CHR,ITEM_CHR); 222 IF ITEM_CHR /= CHR THEN 223 FAILED ("INCORRECT CHR VALUE READ - 1"); 224 END IF; 225 EXCEPTION 226 WHEN OTHERS => 227 FAILED ("READ WITHOUT FROM FOR " & 228 "TYPE CHARACTER"); 229 END; 230 231 BEGIN 232 READ (FILE_CHR,ITEM_CHR,ONE_CHR); 233 IF ITEM_CHR /= CHR THEN 234 FAILED ("INCORRECT CHR VALUE READ - 2"); 235 END IF; 236 EXCEPTION 237 WHEN OTHERS => 238 FAILED ("READ WITH FROM FOR " & 239 "TYPE CHARACTER"); 240 END; 241 END; 242 243 BEGIN 244 DELETE (FILE_CHR); 245 EXCEPTION 246 WHEN USE_ERROR => 247 NULL; 248 END; 249 250 EXCEPTION 251 WHEN END_SUBTEST => 252 NULL; 253 END; 254 255 DECLARE 256 PACKAGE DIR_INT IS NEW DIRECT_IO (INTEGER); 257 USE DIR_INT; 258 FILE_INT : FILE_TYPE; 259 BEGIN 260 BEGIN 261 CREATE (FILE_INT, INOUT_FILE, LEGAL_FILE_NAME(3)); 262 EXCEPTION 263 WHEN USE_ERROR | NAME_ERROR => 264 NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " & 265 "ON CREATE - INTEGER"); 266 RAISE END_SUBTEST; 267 WHEN OTHERS => 268 FAILED ("UNEXPECTED ERROR RAISED ON " & 269 "CREATE - INTEGER"); 270 RAISE END_SUBTEST; 271 END; 272 273 DECLARE 274 INT : INTEGER := IDENT_INT (33); 275 ITEM_INT : INTEGER; 276 ONE_INT : POSITIVE_COUNT := 1; 277 TWO_INT : POSITIVE_COUNT := 2; 278 BEGIN 279 BEGIN 280 WRITE (FILE_INT,INT); 281 EXCEPTION 282 WHEN OTHERS => 283 FAILED ("EXCEPTION RAISED ON WRITE FOR " & 284 "INTEGER - 1"); 285 END; 286 287 BEGIN 288 WRITE (FILE_INT,INT,TWO_INT); 289 EXCEPTION 290 WHEN OTHERS => 291 FAILED ("EXCEPTION RAISED ON WRITE FOR " & 292 "INTEGER - 2"); 293 END; 294 295 BEGIN 296 IF SIZE (FILE_INT) /= TWO_INT THEN 297 FAILED ("SIZE FOR TYPE INTEGER"); 298 END IF; 299 IF NOT END_OF_FILE (FILE_INT) THEN 300 FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " & 301 "INTEGER"); 302 END IF; 303 SET_INDEX (FILE_INT, ONE_INT); 304 IF INDEX (FILE_INT) /= ONE_INT THEN 305 FAILED ("WRONG INDEX VALUE FOR TYPE INTEGER"); 306 END IF; 307 END; 308 309 CLOSE (FILE_INT); 310 311 BEGIN 312 OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME(3)); 313 EXCEPTION 314 WHEN USE_ERROR => 315 NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " & 316 "NOT SUPPORTED - 3"); 317 RAISE END_SUBTEST; 318 END; 319 320 BEGIN 321 READ (FILE_INT,ITEM_INT); 322 IF ITEM_INT /= INT THEN 323 FAILED ("INCORRECT INT VALUE READ - 1"); 324 END IF; 325 EXCEPTION 326 WHEN OTHERS => 327 FAILED ("READ WITHOUT FROM FOR " & 328 "TYPE INTEGER"); 329 END; 330 331 BEGIN 332 READ (FILE_INT,ITEM_INT,ONE_INT); 333 IF ITEM_INT /= INT THEN 334 FAILED ("INCORRECT INT VALUE READ - 2"); 335 END IF; 336 EXCEPTION 337 WHEN OTHERS => 338 FAILED ("READ WITH FROM FOR " & 339 "TYPE INTEGER"); 340 END; 341 END; 342 343 BEGIN 344 DELETE (FILE_INT); 345 EXCEPTION 346 WHEN USE_ERROR => 347 NULL; 348 END; 349 350 EXCEPTION 351 WHEN END_SUBTEST => 352 NULL; 353 END; 354 355 RESULT; 356 357END CE2401A; 358