1-- CE3809A.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 I/O GET CAN READ A VALUE FROM A STRING. 27-- CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING 28-- OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION 29-- CHARACTERS. CHECK THAT LAST CONTAINS THE INDEX OF THE LAST 30-- CHARACTER READ FROM THE STRING. 31 32-- HISTORY: 33-- SPS 10/07/82 34-- SPS 12/14/82 35-- JBG 12/21/82 36-- DWC 09/15/87 ADDED CASE TO INCLUDE ONLY TABS IN STRING AND 37-- CHECKED THAT END_ERROR IS RAISED. 38 39WITH REPORT; USE REPORT; 40WITH TEXT_IO; USE TEXT_IO; 41 42PROCEDURE CE3809A IS 43BEGIN 44 45 TEST ("CE3809A", "CHECK THAT FLOAT_IO GET " & 46 "OPERATES CORRECTLY ON STRINGS"); 47 48 DECLARE 49 TYPE FL IS DIGITS 4; 50 PACKAGE FLIO IS NEW FLOAT_IO (FL); 51 USE FLIO; 52 X : FL; 53 STR : STRING (1..10) := " 10.25 "; 54 L : POSITIVE; 55 BEGIN 56 57-- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT 58 BEGIN 59 GET ("896.5 ", X, L); 60 IF X /= 896.5 THEN 61 FAILED ("FLOAT VALUE FROM STRING INCORRECT"); 62 END IF; 63 EXCEPTION 64 WHEN DATA_ERROR => 65 FAILED ("DATA_ERROR RAISED - FLOAT - 1"); 66 WHEN OTHERS => 67 FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 1"); 68 END; 69 70 IF L /= IDENT_INT (5) THEN 71 FAILED ("VALUE OF LAST INCORRECT - FLOAT - 1. LAST IS" & 72 INTEGER'IMAGE(L)); 73 END IF; 74 75-- STRING LITERAL WITH BLANKS 76 BEGIN 77 GET (" ", X, L); 78 FAILED ("END_ERROR NOT RAISED - FLOAT - 2"); 79 EXCEPTION 80 WHEN END_ERROR => 81 IF L /= 5 THEN 82 FAILED ("AFTER END_ERROR, VALUE OF LAST " & 83 "INCORRECT - 2. LAST IS" & 84 INTEGER'IMAGE(L)); 85 END IF; 86 WHEN DATA_ERROR => 87 FAILED ("DATA_ERROR RAISED - FLOAT - 2"); 88 WHEN OTHERS => 89 FAILED ("WRONG EXCEPTION RAISED - FLOAT - 2"); 90 END; 91 92-- NULL STRING LITERAL 93 BEGIN 94 GET ("", X, L); 95 FAILED ("END_ERROR NOT RAISED - FLOAT - 3"); 96 EXCEPTION 97 WHEN END_ERROR => 98 IF L /= 5 THEN 99 FAILED ("AFTER END_ERROR, VALUE OF LAST " & 100 "INCORRECT - 3. LAST IS" & 101 INTEGER'IMAGE(L)); 102 END IF; 103 WHEN DATA_ERROR => 104 FAILED ("DATA_ERROR RAISED - FLOAT - 3"); 105 WHEN OTHERS => 106 FAILED ("WRONG EXCEPTION RAISED - FLOAT - 3"); 107 END; 108 109-- NULL SLICE 110 BEGIN 111 GET (STR(5..IDENT_INT(2)), X, L); 112 FAILED ("END_ERROR NOT RAISED - FLOAT - 4"); 113 EXCEPTION 114 WHEN END_ERROR => 115 IF L /= 5 THEN 116 FAILED ("AFTER END_ERROR, VALUE OF LAST " & 117 "INCORRECT - 4. LAST IS" & 118 INTEGER'IMAGE(L)); 119 END IF; 120 WHEN DATA_ERROR => 121 FAILED ("DATA_ERROR RAISED - FLOAT - 4"); 122 WHEN OTHERS => 123 FAILED ("WRONG EXCEPTION RAISED - FLOAT - 4"); 124 END; 125 126-- SLICE WITH BLANKS 127 BEGIN 128 GET (STR(IDENT_INT(9)..10), X, L); 129 FAILED ("END_ERROR NOT RAISED - FLOAT - 5"); 130 EXCEPTION 131 WHEN END_ERROR => 132 IF L /= IDENT_INT(5) THEN 133 FAILED ("AFTER END_ERROR, VALUE OF LAST " & 134 "INCORRECT - 5. LAST IS" & 135 INTEGER'IMAGE(L)); 136 END IF; 137 WHEN DATA_ERROR => 138 FAILED ("DATA_ERROR RAISED - FLOAT - 5"); 139 WHEN OTHERS => 140 FAILED ("WRONG EXCEPTION RAISED - FLOAT - 5"); 141 END; 142 143-- NON-NULL SLICE 144 BEGIN 145 GET (STR(2..IDENT_INT(8)), X, L); 146 IF X /= 10.25 THEN 147 FAILED ("FLOAT VALUE INCORRECT - 6"); 148 END IF; 149 IF L /= 8 THEN 150 FAILED ("LAST INCORRECT FOR SLICE - 6. LAST IS" & 151 INTEGER'IMAGE(L)); 152 END IF; 153 EXCEPTION 154 WHEN OTHERS => 155 FAILED ("EXCEPTION RAISED - 6"); 156 END; 157 158-- LEFT-JUSTIFIED, POSITIVE EXPONENT 159 BEGIN 160 GET ("1.34E+02", X, L); 161 IF X /= 134.0 THEN 162 FAILED ("FLOAT WITH EXP FROM STRING INCORRECT - 7"); 163 END IF; 164 165 IF L /= 8 THEN 166 FAILED ("VALUE OF LAST INCORRECT - FLOAT - 7. " & 167 "LAST IS" & INTEGER'IMAGE(L)); 168 END IF; 169 EXCEPTION 170 WHEN DATA_ERROR => 171 FAILED ("DATA_EROR RAISED - FLOAT - 7"); 172 WHEN OTHERS => 173 FAILED ("UNEXPECTED EXCEPTION RAISED - FLOAT - 7"); 174 END; 175 176-- RIGHT-JUSTIFIED, NEGATIVE EXPONENT 177 BEGIN 178 GET (" 25.0E-2", X, L); 179 IF X /= 0.25 THEN 180 FAILED ("NEG EXPONENT INCORRECT - 8"); 181 END IF; 182 IF L /= 8 THEN 183 FAILED ("LAST INCORRECT - 8. LAST IS" & 184 INTEGER'IMAGE(L)); 185 END IF; 186 EXCEPTION 187 WHEN OTHERS => 188 FAILED ("EXCEPTION RAISED - 8"); 189 END; 190 191-- RIGHT-JUSTIFIED, NEGATIVE 192 GET (" -1.50", X, L); 193 IF X /= -1.5 THEN 194 FAILED ("FLOAT IN RIGHT JUSTIFIED STRING INCORRECT - 9"); 195 END IF; 196 IF L /= 7 THEN 197 FAILED ("LAST INCORRECT - 9. LAST IS" & 198 INTEGER'IMAGE(L)); 199 END IF; 200 201-- HORIZONTAL TAB WITH BLANKS 202 BEGIN 203 GET (" " & ASCII.HT & "2.3E+2", X, L); 204 IF X /= 230.0 THEN 205 FAILED ("FLOAT WITH TAB IN STRING INCORRECT - 10"); 206 END IF; 207 IF L /= 8 THEN 208 FAILED ("LAST INCORRECT FOR TAB - 10. LAST IS" & 209 INTEGER'IMAGE(L)); 210 END IF; 211 EXCEPTION 212 WHEN DATA_ERROR => 213 FAILED ("DATA_ERROR FOR STRING WITH TAB - 10"); 214 WHEN OTHERS => 215 FAILED ("SOME EXCEPTION RAISED FOR STRING WITH " & 216 "TAB - 10"); 217 END; 218 219-- HORIZONTAL TABS ONLY 220 BEGIN 221 GET (ASCII.HT & ASCII.HT, X, L); 222 FAILED ("END_ERROR NOT RAISED - FLOAT - 11"); 223 EXCEPTION 224 WHEN END_ERROR => 225 IF L /= IDENT_INT(8) THEN 226 FAILED ("AFTER END_ERROR, VALUE OF LAST " & 227 "INCORRECT - 11. LAST IS" & 228 INTEGER'IMAGE(L)); 229 END IF; 230 WHEN DATA_ERROR => 231 FAILED ("DATA_ERROR RAISED - FLOAT - 11"); 232 WHEN OTHERS => 233 FAILED ("WRONG EXCEPTION RAISED - FLOAT - 11"); 234 END; 235 END; 236 237 RESULT; 238 239END CE3809A; 240