1-- CE3806D.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 FLOAT_IO PUT OPERATES ON FILES OF MODE OUT_FILE AND 27-- IF NO FILE IS SPECIFIED THE CURRENT DEFAULT OUTPUT FILE IS USED. 28 29--- APPLICABILITY CRITERIA: 30-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT 31-- TEXT FILES. 32 33-- HISTORY: 34-- SPS 10/06/82 35-- VKG 02/15/83 36-- JBG 02/22/84 CHANGED TO .ADA TEST 37-- RJW 11/04/86 REVISED TEST TO OUTPUT A NOT_APPLICABLE 38-- RESULT WHEN FILES ARE NOT SUPPORTED. 39-- JLH 09/14/87 REMOVED DEPENDENCE ON RESET AND CORRECT EXCEPTION 40-- HANDLING. 41 42WITH REPORT; 43USE REPORT; 44WITH TEXT_IO; 45USE TEXT_IO; 46 47PROCEDURE CE3806D IS 48 49BEGIN 50 51 TEST ("CE3806D", "CHECK THAT FLOAT_IO OPERATES ON FILES OF MODE " & 52 "OUT_FILE AND IF NO FILE IS SPECIFIED THE " & 53 "CURRENT DEFAULT OUTPUT FILE IS USED"); 54 55 DECLARE 56 FT1, FT2 : FILE_TYPE; 57 TYPE FL IS DIGITS 3; 58 PACKAGE FLIO IS NEW FLOAT_IO (FL); 59 USE FLIO; 60 INCOMPLETE : EXCEPTION; 61 X : FL := -1.5; 62 63 BEGIN 64 65 BEGIN 66 CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); 67 EXCEPTION 68 WHEN USE_ERROR => 69 NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & 70 "WITH OUT_FILE MODE"); 71 RAISE INCOMPLETE; 72 WHEN NAME_ERROR => 73 NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & 74 "CREATE WITH OUT_FILE MODE"); 75 RAISE INCOMPLETE; 76 END; 77 78 CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); 79 80 SET_OUTPUT (FT2); 81 82 BEGIN 83 PUT (FT1, X); 84 PUT (X + 1.0); 85 CLOSE (FT1); 86 87 BEGIN 88 OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); 89 EXCEPTION 90 WHEN USE_ERROR => 91 NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & 92 "OPEN WITH IN_FILE MODE"); 93 RAISE INCOMPLETE; 94 END; 95 96 SET_OUTPUT (STANDARD_OUTPUT); 97 98 CLOSE (FT2); 99 OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); 100 101 X := 0.0; 102 GET (FT1, X); 103 IF X /= -1.5 THEN 104 FAILED ("VALUE INCORRECT - FLOAT FROM FILE"); 105 END IF; 106 X := 0.0; 107 GET (FT2, X); 108 IF X /= -0.5 THEN 109 FAILED (" VVALUE INCORRECT - FLOAT FROM DEFAULT"); 110 END IF; 111 END; 112 113 BEGIN 114 DELETE (FT1); 115 DELETE (FT2); 116 EXCEPTION 117 WHEN USE_ERROR => 118 NULL; 119 END; 120 121 EXCEPTION 122 WHEN INCOMPLETE => 123 NULL; 124 125 END; 126 127 RESULT; 128 129END CE3806D; 130