old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c35507c.ada

   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
  38 WITH REPORT; USE REPORT;
  39
  40 PROCEDURE  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
  64 BEGIN
  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;
 360 END C35507C;