1-- CE3801B.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 EACH FIXED_IO OPERATION RAISES STATUS_ERROR 27-- WHEN CALLED WITH A FILE PARAMETER DESIGNATING AN UN-OPEN FILE. 28 29-- HISTORY: 30-- DWC 09/11/87 CREATED ORIGINAL TEST. 31 32WITH REPORT; 33USE REPORT; 34WITH TEXT_IO; 35USE TEXT_IO; 36 37PROCEDURE CE3801B IS 38BEGIN 39 40 TEST ("CE3801B", "CHECK THAT EACH FIXED_IO " & 41 "OPERATION RAISES STATUS_ERROR WHEN CALLED " & 42 "WITH A FILE PARAMETER DESIGNATING AN " & 43 "UN-OPEN FILE"); 44 45 DECLARE 46 TYPE FIX IS DELTA 0.1 RANGE 1.0 .. 10.0; 47 PACKAGE FIX_IO IS NEW FIXED_IO (FIX); 48 USE FIX_IO; 49 X : FIX := FIX'LAST; 50 FT : FILE_TYPE; 51 52 BEGIN 53 BEGIN 54 GET (FT, X); 55 FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 1"); 56 EXCEPTION 57 WHEN STATUS_ERROR => 58 NULL; 59 WHEN OTHERS => 60 FAILED ("WRONG EXCEPTION RAISED - GET " & 61 "FIXED_IO - 1"); 62 END; 63 64 BEGIN 65 PUT (FT, X); 66 FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 1"); 67 EXCEPTION 68 WHEN STATUS_ERROR => 69 NULL; 70 WHEN OTHERS => 71 FAILED ("WRONG EXCEPTION RAISED - PUT " & 72 "FIXED_IO - 1"); 73 END; 74 75 BEGIN 76 CREATE (FT, OUT_FILE); -- THIS IS JUST AN ATTEMPT TO 77 CLOSE (FT); -- CREATE A FILE. OBJECTIVE 78 EXCEPTION -- IS MET EITHER WAY. 79 WHEN USE_ERROR => 80 NULL; 81 END; 82 83 BEGIN 84 GET (FT, X); 85 FAILED ("STATUS_ERROR NOT RAISED - GET FIXED_IO - 2"); 86 EXCEPTION 87 WHEN STATUS_ERROR => 88 NULL; 89 WHEN OTHERS => 90 FAILED ("WRONG EXCEPTION RAISED - GET " & 91 "FIXED_IO - 2"); 92 END; 93 94 BEGIN 95 PUT (FT, X); 96 FAILED ("STATUS_ERROR NOT RAISED - PUT FIXED_IO - 2"); 97 EXCEPTION 98 WHEN STATUS_ERROR => 99 NULL; 100 WHEN OTHERS => 101 FAILED ("WRONG EXCEPTION RAISED - PUT " & 102 "FIXED_IO - 2"); 103 END; 104 END; 105 106 RESULT; 107 108END CE3801B; 109