1-- CE3806G.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 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-- JLH 09/13/87 CREATED ORIGINAL TEST. 35-- BCB 10/03/90 ADDED THE STATEMENT "RAISE INCOMPLETE;" TO 36-- NAME_ERROR EXCEPTION HANDLER. 37 38WITH REPORT; USE REPORT; 39WITH TEXT_IO; USE TEXT_IO; 40 41PROCEDURE CE3806G IS 42 43BEGIN 44 45 TEST ("CE3806G", "CHECK THAT FIXED_IO PUT OPERATES ON FILES " & 46 "OF MODE OUT_FILE AND IF NO FILE IS SPECIFIED " & 47 "THE CURRENT DEFAULT OUTPUT FILE IS USED"); 48 49 DECLARE 50 FT1, FT2 : FILE_TYPE; 51 TYPE FX IS DELTA 0.5 RANGE -10.0 .. 10.0; 52 PACKAGE FXIO IS NEW FIXED_IO (FX); 53 USE FXIO; 54 INCOMPLETE : EXCEPTION; 55 X : FX := -1.5; 56 57 BEGIN 58 59 BEGIN 60 CREATE (FT1, OUT_FILE, LEGAL_FILE_NAME); 61 EXCEPTION 62 WHEN USE_ERROR => 63 NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " & 64 "WITH OUT_FILE MODE"); 65 RAISE INCOMPLETE; 66 WHEN NAME_ERROR => 67 NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " & 68 "CREATE WITH OUT_FILE MODE"); 69 RAISE INCOMPLETE; 70 END; 71 72 CREATE (FT2, OUT_FILE, LEGAL_FILE_NAME(2)); 73 74 SET_OUTPUT (FT2); 75 76 BEGIN 77 PUT (FT1, X); 78 PUT (X + 1.0); 79 80 CLOSE (FT1); 81 82 BEGIN 83 OPEN (FT1, IN_FILE, LEGAL_FILE_NAME); 84 EXCEPTION 85 WHEN USE_ERROR => 86 NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT " & 87 "OPEN WITH IN_FILE MODE"); 88 RAISE INCOMPLETE; 89 END; 90 91 SET_OUTPUT (STANDARD_OUTPUT); 92 93 CLOSE (FT2); 94 95 OPEN (FT2, IN_FILE, LEGAL_FILE_NAME(2)); 96 97 X := 0.0; 98 GET (FT1, X); 99 IF X /= -1.5 THEN 100 FAILED ("VALUE INCORRECT - FIXED FROM FILE"); 101 END IF; 102 X := 0.0; 103 GET (FT2, X); 104 IF X /= -0.5 THEN 105 FAILED ("VALUE INCORRECT - FIXED FROM DEFAULT"); 106 END IF; 107 END; 108 109 BEGIN 110 DELETE (FT1); 111 DELETE (FT2); 112 EXCEPTION 113 WHEN USE_ERROR => 114 NULL; 115 END; 116 117 EXCEPTION 118 WHEN INCOMPLETE => 119 NULL; 120 121 END; 122 123 RESULT; 124 125END CE3806G; 126