1-- CE3704N.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 GET FOR INTEGER_IO RAISES DATA_ERROR WHEN: 27-- (A) BASE LESS THAN 2 OR GREATER THAN 16 28-- (B) THE LETTERS IN BASE ARE OUT OF THE BASE RANGE 29-- (C) THERE IS NO CLOSING '#' SIGN FOR A BASED LITERAL 30 31-- APPLICABILITY CRITERIA: 32-- THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH 33-- SUPPORT TEXT FILES. 34 35-- HISTORY: 36-- VKG 02/10/83 37-- SPS 03/16/83 38-- CPP 07/30/84 39-- RJW 11/04/86 REVISED TEST TO OUTPUT A NON_APPLICABLE 40-- RESULT WHEN FILES ARE NOT SUPPORTED. 41-- DWC 09/11/87 REMOVED UNNECESSARY CODE, CORRECTED 42-- EXCEPTION HANDLING, AND CHECKED FOR 43-- USE_ERROR ON DELETE. 44 45WITH TEXT_IO; USE TEXT_IO; 46WITH REPORT ; USE REPORT ; 47 48PROCEDURE CE3704N IS 49 INCOMPLETE : EXCEPTION; 50 51BEGIN 52 TEST ("CE3704N" ,"CHECK THAT DATA_ERROR IS RAISED WHEN " & 53 "A BASED LITERAL DOES NOT HAVE ITS BASE " & 54 "IN THE RANGE 2 .. 16, DIGIT IS OUTSIDE " & 55 "THE BASE RANGE, OR THERE IS NO CLOSING " & 56 "'#' SIGN"); 57 58 DECLARE 59 FT : FILE_TYPE; 60 BEGIN 61 BEGIN 62 CREATE (FT, OUT_FILE, LEGAL_FILE_NAME); 63 EXCEPTION 64 WHEN USE_ERROR => 65 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " & 66 "WITH OUT_FILE MODE"); 67 RAISE INCOMPLETE; 68 WHEN NAME_ERROR => 69 NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " & 70 "WITH OUT_FILE MODE"); 71 RAISE INCOMPLETE; 72 END; 73 74 PUT (FT, "1#0000#"); 75 NEW_LINE (FT); 76 PUT (FT, "A#234567#"); 77 NEW_LINE (FT); 78 PUT (FT, "17#123#1"); 79 NEW_LINE (FT); 80 PUT (FT, "5#1253#2"); 81 NEW_LINE (FT); 82 PUT (FT, "8#123"); 83 CLOSE (FT); 84 85 DECLARE 86 PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER); 87 USE INT_IO; 88 X : INTEGER := 1003; 89 CH : CHARACTER; 90 BEGIN 91 BEGIN 92 OPEN (FT, IN_FILE, LEGAL_FILE_NAME); 93 EXCEPTION 94 WHEN USE_ERROR => 95 NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " & 96 "OPEN WITH IN_FILE MODE"); 97 RAISE INCOMPLETE; 98 END; 99 100 BEGIN 101 GET (FT, X); 102 FAILED ("DATA_ERROR NOT RAISED - (1)"); 103 EXCEPTION 104 WHEN DATA_ERROR => 105 IF X /= 1003 THEN 106 FAILED ("ACTUAL PARAMETER TO GET " & 107 "AFFECTED ON DATA_ERROR"); 108 END IF; 109 WHEN OTHERS => 110 FAILED ("WRONG EXCEPTION RAISED - (1)"); 111 END; 112 113 IF NOT END_OF_LINE (FT) THEN 114 GET (FT, CH); 115 FAILED ("GET STOPPED AT WRONG POSITION - " & 116 "(1): CHAR IS " & CH); 117 END IF; 118 119 SKIP_LINE (FT); 120 121 BEGIN 122 GET (FT, X); 123 FAILED ("DATA_ERROR NOT RAISED - (2)"); 124 EXCEPTION 125 WHEN DATA_ERROR => 126 IF X /= 1003 THEN 127 FAILED ("ACTUAL PARAMETER TO GET " & 128 "AFFECTED ON DATA_ERROR - (2)"); 129 END IF; 130 WHEN OTHERS => 131 FAILED ("WRONG EXCEPTION RAISED - (2)"); 132 END; 133 134 IF END_OF_LINE (FT) THEN 135 FAILED ("GET STOPPED AT END OF LINE - (2)"); 136 ELSE 137 GET (FT, CH); 138 IF CH /= 'A' THEN 139 FAILED ("GET STOPPED AT WRONG POSITION " & 140 "- (2): CHAR IS " & CH); 141 END IF; 142 END IF; 143 144 SKIP_LINE (FT); 145 146 BEGIN 147 GET (FT, X); 148 FAILED ("DATA_ERROR NOT RAISED - (2A)"); 149 EXCEPTION 150 WHEN DATA_ERROR => 151 IF X /= 1003 THEN 152 FAILED ("ACTUAL PARAMETER TO GET " & 153 "AFFECTED ON DATA_ERROR - (2A)"); 154 END IF; 155 WHEN OTHERS => 156 FAILED ("WRONG EXCEPTION RAISED - (2A)"); 157 END; 158 159 IF NOT END_OF_LINE (FT) THEN 160 GET (FT, CH); 161 IF CH /= '1' THEN 162 FAILED ("GET STOPPED AT WRONG POSITION " & 163 "- (2A): CHAR IS " & CH); 164 END IF; 165 END IF; 166 167 SKIP_LINE (FT); 168 169 BEGIN 170 GET (FT, X); 171 FAILED ("DATA_ERROR NOT RAISED - (3)"); 172 EXCEPTION 173 WHEN DATA_ERROR => 174 IF X /= 1003 THEN 175 FAILED ("ACTUAL PARAMETER TO GET " & 176 "AFFECTED ON DATA_ERROR - (3)"); 177 END IF; 178 WHEN OTHERS => 179 FAILED ("WRONG EXCEPTION RAISED - (3)"); 180 END; 181 182 IF NOT END_OF_LINE (FT) THEN 183 GET (FT, CH); 184 IF CH /= '2' THEN 185 FAILED ("GET STOPPED AT WRONG POSITION - " & 186 "(3): CHAR IS " & CH); 187 END IF; 188 END IF; 189 190 SKIP_LINE (FT); 191 192 BEGIN 193 GET (FT, X); 194 FAILED ("DATA_ERROR NOT RAISED - (4)"); 195 EXCEPTION 196 WHEN DATA_ERROR => 197 IF X /= 1003 THEN 198 FAILED ("ACTUAL PARAMETER TO GET " & 199 "AFFECTED ON DATA_ERROR - (4)"); 200 END IF; 201 WHEN OTHERS => 202 FAILED ("WRONG EXCEPTION RAISED - (4)"); 203 END; 204 205 IF NOT END_OF_LINE (FT) THEN 206 GET (FT, CH); 207 IF CH /= ' ' THEN 208 FAILED ("GET STOPPED AT WRONG POSITION " & 209 "- (4): CHAR IS " & CH); 210 END IF; 211 END IF; 212 213 END; 214 215 BEGIN 216 DELETE (FT); 217 EXCEPTION 218 WHEN USE_ERROR => 219 NULL; 220 END; 221 222 EXCEPTION 223 WHEN INCOMPLETE => 224 NULL; 225 END; 226 227 RESULT; 228 229END CE3704N; 230