1-- CE3804J.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 FIXED_IO GET OPERATES ON IN_FILE FILE AND WHEN 27-- NO FILE IS SPECIFIED THE CURRENT DEFAULT INPUT FILE IS USED. 28 29-- APPLICABILITY CRITERIA: 30-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH 31-- SUPPORT TEXT FILES. 32 33-- HISTORY: 34-- DWC 09/14/87 CREATED ORIGINAL TEST. 35-- JRL 02/28/96 Changed upper bound of type FX from 1000.0 to 250.0. 36-- Corrected TEST string. 37 38WITH REPORT; 39USE REPORT; 40WITH TEXT_IO; 41USE TEXT_IO; 42 43PROCEDURE CE3804J IS 44 INCOMPLETE : EXCEPTION; 45 46BEGIN 47 48 TEST ("CE3804J", "CHECK THAT FIXED_IO GET OPERATES ON " & 49 "IN_FILE FILE AND WHEN NO FILE IS " & 50 "SPECIFIED THE CURRENT DEFAULT INPUT " & 51 "FILE IS USED"); 52 53 DECLARE 54 FT1, FT2 : FILE_TYPE; 55 BEGIN 56 57-- CREATE AND INITIALIZE FILES 58 59 BEGIN 60 CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); 61 EXCEPTION 62 WHEN USE_ERROR => 63 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & 64 "CREATE WITH OUT_FILE MODE - 1"); 65 RAISE INCOMPLETE; 66 WHEN NAME_ERROR => 67 NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT " & 68 "CREATE WITH OUT_FILE MODE - 1"); 69 RAISE INCOMPLETE; 70 END; 71 72 CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); 73 74 PUT (FT1, "1.0"); 75 NEW_LINE (FT1); 76 77 CLOSE (FT1); 78 79 BEGIN 80 OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); 81 EXCEPTION 82 WHEN USE_ERROR => 83 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " & 84 "FOR IN_FILE MODE"); 85 RAISE INCOMPLETE; 86 END; 87 88 PUT (FT2, "2.0"); 89 NEW_LINE (FT2); 90 91 CLOSE (FT2); 92 OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); 93 94 SET_INPUT (FT2); 95 96 DECLARE 97 TYPE FX IS DELTA 0.0001 RANGE 1.0 .. 250.0; 98 PACKAGE FXIO IS NEW FIXED_IO (FX); 99 USE FXIO; 100 X : FX; 101 BEGIN 102 BEGIN 103 GET (FT1, X); 104 IF X /= 1.0 THEN 105 FAILED ("FIXED FILE VALUE INCORRECT"); 106 END IF; 107 EXCEPTION 108 WHEN OTHERS => 109 FAILED ("EXCEPTION RAISED - FILE FIXED"); 110 END; 111 112 BEGIN 113 GET (X); 114 IF X /= 2.0 THEN 115 FAILED ("FIXED DEFAULT VALUE INCORRECT"); 116 END IF; 117 EXCEPTION 118 WHEN OTHERS => 119 FAILED ("EXCEPTION RAISED - DEFAULT FIXED"); 120 END; 121 END; 122 123 BEGIN 124 DELETE (FT1); 125 DELETE (FT2); 126 EXCEPTION 127 WHEN USE_ERROR => 128 NULL; 129 END; 130 EXCEPTION 131 WHEN INCOMPLETE => 132 NULL; 133 END; 134 135 RESULT; 136 137END CE3804J; 138