1-- C35507C.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 THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT 27-- RESULTS WHEN THE PREFIX IS A CHARACTER TYPE. 28-- SUBTESTS ARE: 29-- (A). TESTS FOR IMAGE. 30-- (B). TESTS FOR VALUE. 31 32-- HISTORY: 33-- RJW 05/29/86 CREATED ORIGINAL TEST. 34-- BCB 08/18/87 CHANGED HEADER TO STANDARD HEADER FORMAT. 35-- CORRECTED ERROR MESSAGES AND ADDED CALLS TO 36-- IDENT_STR. 37 38WITH REPORT; USE REPORT; 39 40PROCEDURE C35507C IS 41 42 TYPE CHAR IS ('A', 'a'); 43 44 TYPE NEWCHAR IS NEW CHAR; 45 46 FUNCTION IDENT (CH : CHAR) RETURN CHAR IS 47 BEGIN 48 RETURN CHAR'VAL (IDENT_INT (CHAR'POS (CH))); 49 END IDENT; 50 51 FUNCTION IDENT (CH : NEWCHAR) RETURN NEWCHAR IS 52 BEGIN 53 RETURN NEWCHAR'VAL (IDENT_INT (NEWCHAR'POS (CH))); 54 END IDENT; 55 56 PROCEDURE CHECK_BOUND (STR1, STR2 : STRING) IS 57 BEGIN 58 IF STR1'FIRST /= 1 THEN 59 FAILED ( "INCORRECT LOWER BOUND FOR " & STR2 & 60 "'IMAGE ('" & STR1 & "')" ); 61 END IF; 62 END CHECK_BOUND; 63 64BEGIN 65 66 TEST( "C35507C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " & 67 "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " & 68 "PREFIX IS A CHARACTER TYPE" ); 69 70 BEGIN -- (A). 71 IF CHAR'IMAGE ('A') /= "'A'" THEN 72 FAILED ( "INCORRECT IMAGE FOR CHAR'('A')" ); 73 END IF; 74 75 CHECK_BOUND (CHAR'IMAGE ('A'), "CHAR"); 76 77 IF CHAR'IMAGE ('a') /= "'a'" THEN 78 FAILED ( "INCORRECT IMAGE FOR CHAR'('a')" ); 79 END IF; 80 81 CHECK_BOUND (CHAR'IMAGE ('a'), "CHAR"); 82 83 IF NEWCHAR'IMAGE ('A') /= "'A'" THEN 84 FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('A')" ); 85 END IF; 86 87 CHECK_BOUND (NEWCHAR'IMAGE ('A'), "NEWCHAR"); 88 89 IF NEWCHAR'IMAGE ('a') /= "'a'" THEN 90 FAILED ( "INCORRECT IMAGE FOR NEWCHAR'('a')" ); 91 END IF; 92 93 CHECK_BOUND (NEWCHAR'IMAGE ('a'), "NEWCHAR"); 94 95 IF CHAR'IMAGE (IDENT ('A')) /= "'A'" THEN 96 FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('A'))" ); 97 END IF; 98 99 CHECK_BOUND (CHAR'IMAGE (IDENT ('A')), "IDENT OF CHAR"); 100 101 IF CHAR'IMAGE (IDENT ('a')) /= "'a'" THEN 102 FAILED ( "INCORRECT IMAGE FOR CHAR'( IDENT ('a'))" ); 103 END IF; 104 105 CHECK_BOUND (CHAR'IMAGE (IDENT ('a')), "IDENT OF CHAR"); 106 107 IF NEWCHAR'IMAGE (IDENT ('A')) /= "'A'" THEN 108 FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('A'))" ); 109 END IF; 110 111 CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('A')), "IDENT OF NEWCHAR"); 112 113 IF NEWCHAR'IMAGE (IDENT ('a')) /= "'a'" THEN 114 FAILED ( "INCORRECT IMAGE FOR NEWCHAR'( IDENT ('a'))" ); 115 END IF; 116 117 CHECK_BOUND (NEWCHAR'IMAGE (IDENT ('a')), "IDENT OF NEWCHAR"); 118 119 FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP 120 IF CHARACTER'IMAGE (CH) /= ("'" & CH) & "'" THEN 121 FAILED ( "INCORRECT IMAGE FOR CHARACTER'(" & 122 CH & ")" ); 123 END IF; 124 125 CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER"); 126 127 END LOOP; 128 129 FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP 130 CHECK_BOUND (CHARACTER'IMAGE (CH), "CHARACTER"); 131 END LOOP; 132 133 CHECK_BOUND (CHARACTER'IMAGE (CHARACTER'VAL (127)), 134 "CHARACTER"); 135 136 END; 137 138 --------------------------------------------------------------- 139 140 DECLARE -- (B). 141 142 SUBTYPE SUBCHAR IS CHARACTER 143 RANGE CHARACTER'VAL (127) .. CHARACTER'VAL (127); 144 BEGIN 145 FOR CH IN CHARACTER'VAL (32) .. CHARACTER'VAL (126) LOOP 146 IF SUBCHAR'VALUE (("'" & CH) & "'") /= CH THEN 147 FAILED ( "INCORRECT SUBCHAR'VALUE FOR " & CH ); 148 END IF; 149 END LOOP; 150 151 FOR CH IN CHARACTER'VAL (0) .. CHARACTER'VAL (31) LOOP 152 IF SUBCHAR'VALUE (CHARACTER'IMAGE (CH)) /= CH THEN 153 FAILED ( "INCORRECT SUBCHAR'VALUE FOR " & 154 CHARACTER'IMAGE (CH) ); 155 END IF; 156 END LOOP; 157 158 IF SUBCHAR'VALUE (CHARACTER'IMAGE (CHARACTER'VAL (127))) /= 159 CHARACTER'VAL (127) THEN 160 FAILED ( "INCORRECT SUBCHAR'VALUE FOR " & 161 "CHARACTER'VAL (127)" ); 162 END IF; 163 END; 164 165 BEGIN 166 IF CHAR'VALUE ("'A'") /= 'A' THEN 167 FAILED ( "INCORRECT VALUE FOR CHAR'(""'A'"")" ); 168 END IF; 169 170 IF CHAR'VALUE ("'a'") /= 'a' THEN 171 FAILED ( "INCORRECT VALUE FOR CHAR'(""'a'"")" ); 172 END IF; 173 174 IF NEWCHAR'VALUE ("'A'") /= 'A' THEN 175 FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'A'"")" ); 176 END IF; 177 178 IF NEWCHAR'VALUE ("'a'") /= 'a' THEN 179 FAILED ( "INCORRECT VALUE FOR NEWCHAR'(""'a'"")" ); 180 END IF; 181 END; 182 183 BEGIN 184 IF CHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN 185 FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" & 186 "(""'A'""))" ); 187 END IF; 188 189 IF CHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN 190 FAILED ( "INCORRECT VALUE FOR CHAR'(IDENT_STR" & 191 "(""'a'""))" ); 192 END IF; 193 194 IF NEWCHAR'VALUE (IDENT_STR("'A'")) /= 'A' THEN 195 FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" & 196 "(""'A'""))" ); 197 END IF; 198 199 IF NEWCHAR'VALUE (IDENT_STR("'a'")) /= 'a' THEN 200 FAILED ( "INCORRECT VALUE FOR NEWCHAR'(IDENT_STR" & 201 "(""'a'""))" ); 202 END IF; 203 END; 204 205 BEGIN 206 IF CHAR'VALUE (IDENT_STR ("'B'")) = 'A' THEN 207 FAILED ( "NO EXCEPTION RAISED " & 208 "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 1" ); 209 ELSE 210 FAILED ( "NO EXCEPTION RAISED " & 211 "FOR CHAR'VALUE (IDENT_STR (""'B'"")) - 2" ); 212 END IF; 213 EXCEPTION 214 WHEN CONSTRAINT_ERROR => 215 NULL; 216 WHEN OTHERS => 217 FAILED ( "WRONG EXCEPTION RAISED " & 218 "FOR CHAR'VALUE (IDENT_STR (""'B'""))" ); 219 END; 220 221 BEGIN 222 IF CHARACTER'VALUE (IDENT_CHAR (ASCII.HT) & "'A'") = 'A' THEN 223 FAILED ( "NO EXCEPTION RAISED FOR " & 224 "CHARACTER'VALUE " & 225 "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 1" ); 226 ELSE 227 FAILED ( "NO EXCEPTION RAISED FOR " & 228 "CHARACTER'VALUE " & 229 "(IDENT_CHAR (ASCII.HT) & ""'A'"") - 2" ); 230 END IF; 231 EXCEPTION 232 WHEN CONSTRAINT_ERROR => 233 NULL; 234 WHEN OTHERS => 235 FAILED ( "WRONG EXCEPTION RAISED " & 236 "FOR CHARACTER'VALUE " & 237 "(IDENT_CHAR (ASCII.HT) & ""'A'"")" ); 238 END; 239 240 BEGIN 241 IF CHARACTER'VALUE ("'B'" & IDENT_CHAR (ASCII.HT)) = 'B' THEN 242 FAILED ( "NO EXCEPTION RAISED FOR " & 243 "CHARACTER'VALUE (""'B'"" & " & 244 "IDENT_CHAR (ASCII.HT)) - 1" ); 245 ELSE 246 FAILED ( "NO EXCEPTION RAISED FOR " & 247 "CHARACTER'VALUE (""'B'"" & " & 248 "IDENT_CHAR (ASCII.HT)) - 2" ); 249 END IF; 250 EXCEPTION 251 WHEN CONSTRAINT_ERROR => 252 NULL; 253 WHEN OTHERS => 254 FAILED ( "WRONG EXCEPTION RAISED " & 255 "FOR CHARACTER'VALUE (""'B'"" & " & 256 "IDENT_CHAR (ASCII.HT)) " ); 257 END; 258 259 BEGIN 260 IF CHARACTER'VALUE ("'C'" & IDENT_CHAR (ASCII.BEL)) = 'C' 261 THEN 262 FAILED ( "NO EXCEPTION RAISED FOR " & 263 "CHARACTER'VALUE (""'C'"" & " & 264 "IDENT_CHAR (ASCII.BEL)) - 1" ); 265 ELSE 266 FAILED ( "NO EXCEPTION RAISED FOR " & 267 "CHARACTER'VALUE (""'C'"" & " & 268 "IDENT_CHAR (ASCII.BEL)) - 2" ); 269 END IF; 270 EXCEPTION 271 WHEN CONSTRAINT_ERROR => 272 NULL; 273 WHEN OTHERS => 274 FAILED ( "WRONG EXCEPTION RAISED " & 275 "FOR CHARACTER'VALUE (""'C'"" & " & 276 "IDENT_CHAR (ASCII.BEL))" ); 277 END; 278 279 BEGIN 280 IF CHARACTER'VALUE (IDENT_STR ("'")) = ''' THEN 281 FAILED ( "NO EXCEPTION RAISED FOR " & 282 "CHARACTER'VALUE (IDENT_STR (""'"")) - 1" ); 283 ELSE 284 FAILED ( "NO EXCEPTION RAISED FOR " & 285 "CHARACTER'VALUE (IDENT_STR (""'"")) - 2" ); 286 END IF; 287 EXCEPTION 288 WHEN CONSTRAINT_ERROR => 289 NULL; 290 WHEN OTHERS => 291 FAILED ( "WRONG EXCEPTION RAISED " & 292 "FOR CHARACTER'VALUE (IDENT_STR (""'""))" ); 293 END; 294 295 BEGIN 296 IF CHARACTER'VALUE (IDENT_STR ("''")) = ''' THEN 297 FAILED ( "NO EXCEPTION RAISED FOR " & 298 "CHARACTER'VALUE (IDENT_STR (""''"")) - 1" ); 299 ELSE 300 FAILED ( "NO EXCEPTION RAISED FOR " & 301 "CHARACTER'VALUE (IDENT_STR (""''"")) - 2" ); 302 END IF; 303 EXCEPTION 304 WHEN CONSTRAINT_ERROR => 305 NULL; 306 WHEN OTHERS => 307 FAILED ( "WRONG EXCEPTION RAISED " & 308 "FOR CHARACTER'VALUE (IDENT_STR (""''""))" ); 309 END; 310 311 BEGIN 312 IF CHARACTER'VALUE (IDENT_STR ("'A")) = 'A' THEN 313 FAILED ( "NO EXCEPTION RAISED FOR " & 314 "CHARACTER'VALUE (IDENT_STR (""'A"")) - 1" ); 315 ELSE 316 FAILED ( "NO EXCEPTION RAISED FOR " & 317 "CHARACTER'VALUE (IDENT_STR (""'A"")) - 2" ); 318 END IF; 319 EXCEPTION 320 WHEN CONSTRAINT_ERROR => 321 NULL; 322 WHEN OTHERS => 323 FAILED ( "WRONG EXCEPTION RAISED " & 324 "FOR CHARACTER'VALUE IDENT_STR (""'A""))" ); 325 END; 326 327 BEGIN 328 IF CHARACTER'VALUE (IDENT_STR ("A'")) = 'A' THEN 329 FAILED ( "NO EXCEPTION RAISED FOR " & 330 "CHARACTER'VALUE (IDENT_STR (""A'"")) - 1" ); 331 ELSE 332 FAILED ( "NO EXCEPTION RAISED FOR " & 333 "CHARACTER'VALUE (IDENT_STR (""A'"")) - 2" ); 334 END IF; 335 EXCEPTION 336 WHEN CONSTRAINT_ERROR => 337 NULL; 338 WHEN OTHERS => 339 FAILED ( "WRONG EXCEPTION RAISED " & 340 "FOR CHARACTER'VALUE (IDENT_STR (""A'""))" ); 341 END; 342 343 BEGIN 344 IF CHARACTER'VALUE (IDENT_STR ("'AB'")) = 'A' THEN 345 FAILED ( "NO EXCEPTION RAISED FOR " & 346 "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 1" ); 347 ELSE 348 FAILED ( "NO EXCEPTION RAISED FOR " & 349 "CHARACTER'VALUE (IDENT_STR (""'AB'"")) - 2" ); 350 END IF; 351 EXCEPTION 352 WHEN CONSTRAINT_ERROR => 353 NULL; 354 WHEN OTHERS => 355 FAILED ( "WRONG EXCEPTION RAISED " & 356 "FOR CHARACTER'VALUE IDENT_STR (""'AB'""))" ); 357 END; 358 359 RESULT; 360END C35507C; 361