gcc/testsuite/ada/acats/tests/c3/c35502c.ada

   1 -- C35502C.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 -- CHECK THAT THE ATTRIBUTES 'IMAGE' AND 'VALUE' YIELD THE CORRECT
  26 -- RESULTS WHEN THE PREFIX IS AN ENUMERATION TYPE OTHER THAN A BOOLEAN
  27 -- OR A CHARACTER TYPE.
  28 -- SUBTESTS ARE:
  29 --     PART (A). TESTS FOR IMAGE.
  30 --     PART (B). TESTS FOR VALUE.
  31
  32 -- RJW 5/07/86
  33
  34 WITH REPORT; USE REPORT;
  35
  36 PROCEDURE  C35502C  IS
  37
  38           TYPE ENUM IS (A, BC, ABC, A_B_C, abcd);
  39           SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
  40
  41           TYPE NEWENUM IS NEW ENUM;
  42
  43           FUNCTION IDENT (X : ENUM) RETURN ENUM IS
  44                BEGIN
  45                     IF EQUAL (ENUM'POS (X), ENUM'POS(X)) THEN
  46                          RETURN X;
  47                     END IF;
  48                     RETURN ENUM'FIRST;
  49                END IDENT;
  50
  51 BEGIN
  52
  53      TEST( "C35502C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
  54                        "'VALUE' YIELD THE CORRECT RESULTS " &
  55                        "WHEN THE PREFIX IS AN ENUMERATION TYPE " &
  56                        "OTHER THAN A BOOLEAN OR A CHARACTER TYPE" );
  57
  58 -- PART (A).
  59
  60      BEGIN
  61
  62           IF ENUM'IMAGE ( IDENT(ABC) ) /= "ABC" THEN
  63                FAILED ( "INCORRECT ENUM'IMAGE FOR ABC" );
  64           END IF;
  65           IF ENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
  66                FAILED ( "INCORRECT LOWER BOUND FOR ABC IN ENUM" );
  67           END IF;
  68
  69           IF ENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
  70                FAILED ( "INCORRECT ENUM'IMAGE FOR A_B_C" );
  71           END IF;
  72           IF ENUM'IMAGE ( IDENT(A_B_C) )'FIRST /= 1 THEN
  73                FAILED ( "INCORRECT LOWER BOUND FOR A_B_C IN ENUM" );
  74           END IF;
  75
  76           IF SUBENUM'IMAGE ( IDENT(A_B_C) ) /= "A_B_C" THEN
  77                FAILED ( "INCORRECT SUBENUM'IMAGE FOR A_B_C" );
  78           END IF;
  79           IF SUBENUM'IMAGE ( IDENT(ABC) )'FIRST /= 1 THEN
  80                FAILED ( "INCORRECT LOWER BOUND FOR ABC " &
  81                         "IN SUBENUM" );
  82           END IF;
  83
  84           IF NEWENUM'IMAGE ( ABC ) /= IDENT_STR("ABC") THEN
  85                FAILED ( "INCORRECT NEWENUM'IMAGE FOR ABC" );
  86           END IF;
  87           IF NEWENUM'IMAGE ( ABC )'FIRST /= IDENT_INT(1) THEN
  88                FAILED ( "INCORRECT LOWER BOUND FOR ABC" &
  89                         "IN NEWENUM" );
  90           END IF;
  91
  92           IF ENUM'IMAGE ( IDENT(abcd) ) /= "ABCD" THEN
  93                FAILED ( "INCORRECT ENUM'IMAGE FOR abcd" );
  94           END IF;
  95           IF ENUM'IMAGE ( IDENT(abcd) )'FIRST /= 1 THEN
  96                FAILED ( "INCORRECT LOWER BOUND FOR abcd IN ENUM" );
  97           END IF;
  98
  99      END;
 100
 101 -----------------------------------------------------------------------
 102
 103 -- PART (B).
 104
 105      BEGIN
 106           IF ENUM'VALUE (IDENT_STR("ABC")) /= ABC THEN
 107                FAILED ( "INCORRECT VALUE FOR ""ABC""" );
 108           END IF;
 109      EXCEPTION
 110           WHEN OTHERS =>
 111                FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABC""" );
 112      END;
 113
 114      BEGIN
 115           IF ENUM'VALUE (IDENT_STR("abc")) /= abc THEN
 116                FAILED ( "INCORRECT VALUE FOR ""abc""" );
 117           END IF;
 118      EXCEPTION
 119           WHEN OTHERS =>
 120                FAILED ( "EXCEPTION RAISED - VALUE FOR ""abc""" );
 121      END;
 122
 123      BEGIN
 124           IF ENUM'VALUE ("ABC") /= ABC THEN
 125                FAILED ( "INCORRECT VALUE FOR ABC" );
 126           END IF;
 127      EXCEPTION
 128           WHEN OTHERS =>
 129                FAILED ( "EXCEPTION RAISED - VALUE FOR ABC" );
 130      END;
 131
 132      BEGIN
 133           IF NEWENUM'VALUE (IDENT_STR("abcd")) /= abcd THEN
 134                FAILED ( "INCORRECT VALUE FOR ""abcd""" );
 135           END IF;
 136      EXCEPTION
 137           WHEN OTHERS =>
 138                FAILED ( "EXCEPTION RAISED - VALUE FOR ""abcd""" );
 139      END;
 140
 141      BEGIN
 142           IF NEWENUM'VALUE (IDENT_STR("ABCD")) /= abcd THEN
 143                FAILED ( "INCORRECT VALUE FOR ""ABCD""" );
 144           END IF;
 145      EXCEPTION
 146           WHEN OTHERS =>
 147                FAILED ( "EXCEPTION RAISED - VALUE FOR ""ABCD""" );
 148      END;
 149
 150      BEGIN
 151           IF NEWENUM'VALUE ("abcd") /= abcd THEN
 152                FAILED ( "INCORRECT VALUE FOR abcd" );
 153           END IF;
 154      EXCEPTION
 155           WHEN OTHERS =>
 156                FAILED ( "EXCEPTION RAISED - VALUE FOR abcd" );
 157      END;
 158
 159      BEGIN
 160           IF SUBENUM'VALUE (IDENT_STR("A_B_C")) /= A_B_C THEN
 161                FAILED ( "INCORRECT VALUE FOR ""A_B_C""" );
 162           END IF;
 163      EXCEPTION
 164           WHEN OTHERS =>
 165                FAILED ( "EXCEPTION RAISED - VALUE FOR ""A_B_C""" );
 166      END;
 167
 168      BEGIN
 169           IF ENUM'VALUE (IDENT_STR("ABC     ")) /= ABC THEN
 170                FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
 171           END IF;
 172      EXCEPTION
 173           WHEN OTHERS =>
 174                FAILED ( "EXCEPTION RAISED - VALUE WITH " &
 175                         "TRAILING BLANKS" );
 176      END;
 177
 178      BEGIN
 179           IF NEWENUM'VALUE (IDENT_STR("  A_B_C")) /= A_B_C THEN
 180                FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
 181           END IF;
 182      EXCEPTION
 183           WHEN OTHERS =>
 184                FAILED ( "EXCEPTION RAISED - VALUE WITH LEADING " &
 185                         "BLANKS" );
 186      END;
 187
 188      BEGIN
 189           IF ENUM'VALUE (IDENT_STR("A_BC")) /= ABC THEN
 190                FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 1" );
 191           ELSE
 192                FAILED ( "NO EXCEPTION RAISED - ""A_BC"" - 2" );
 193           END IF;
 194      EXCEPTION
 195           WHEN CONSTRAINT_ERROR =>
 196                NULL;
 197           WHEN OTHERS =>
 198                FAILED ( "WRONG EXCEPTION RAISED - ""A_BC""" );
 199      END;
 200
 201      BEGIN
 202           IF ENUM'VALUE (IDENT_STR("A BC")) /= ABC THEN
 203                FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 1" );
 204           ELSE
 205                FAILED ( "NO EXCEPTION RAISED - ""A BC"" - 2" );
 206           END IF;
 207      EXCEPTION
 208           WHEN CONSTRAINT_ERROR =>
 209                NULL;
 210           WHEN OTHERS =>
 211                FAILED ( "WRONG EXCEPTION RAISED - ""A BC""" );
 212      END;
 213
 214      BEGIN
 215           IF ENUM'VALUE (IDENT_STR("A&BC")) /= ABC THEN
 216                FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 1" );
 217           ELSE
 218                FAILED ( "NO EXCEPTION RAISED - ""A&BC"" - 2" );
 219           END IF;
 220      EXCEPTION
 221           WHEN CONSTRAINT_ERROR =>
 222                NULL;
 223           WHEN OTHERS =>
 224                FAILED ( "WRONG EXCEPTION RAISED - ""A&BC""" );
 225      END;
 226
 227      BEGIN
 228           IF ENUM'VALUE (IDENT_CHAR(ASCII.HT) & "BC") /= BC THEN
 229                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
 230           ELSE
 231                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
 232           END IF;
 233      EXCEPTION
 234           WHEN CONSTRAINT_ERROR =>
 235                NULL;
 236           WHEN OTHERS =>
 237                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
 238      END;
 239
 240      BEGIN
 241           IF NEWENUM'VALUE ("A" & (IDENT_CHAR(ASCII.HT))) /= A THEN
 242                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
 243           ELSE
 244                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
 245           END IF;
 246      EXCEPTION
 247           WHEN CONSTRAINT_ERROR =>
 248                NULL;
 249           WHEN OTHERS =>
 250                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
 251      END;
 252
 253      BEGIN
 254           IF ENUM'VALUE (IDENT_STR("B__C")) /= BC THEN
 255                FAILED ( "NO EXCEPTION RAISED - " &
 256                         "CONSECUTIVE UNDERSCORES - 1" );
 257           ELSE
 258                FAILED ( "NO EXCEPTION RAISED - " &
 259                         "CONSECUTIVE UNDERSCORES - 2" );
 260           END IF;
 261      EXCEPTION
 262           WHEN CONSTRAINT_ERROR =>
 263                NULL;
 264           WHEN OTHERS =>
 265                FAILED ( "WRONG EXCEPTION RAISED - " &
 266                         "CONSECUTIVE UNDERSCORES" );
 267      END;
 268
 269      BEGIN
 270           IF NEWENUM'VALUE (IDENT_STR("BC_")) /= BC THEN
 271                FAILED ( "NO EXCEPTION RAISED - " &
 272                         "TRAILING UNDERSCORE - 1" );
 273           ELSE
 274                FAILED ( "NO EXCEPTION RAISED - " &
 275                         "TRAILING UNDERSCORE - 2" );
 276           END IF;
 277      EXCEPTION
 278           WHEN CONSTRAINT_ERROR =>
 279                NULL;
 280           WHEN OTHERS =>
 281                FAILED ( "WRONG EXCEPTION RAISED - " &
 282                         "TRAILING UNDERSCORE" );
 283      END;
 284
 285      BEGIN
 286           IF SUBENUM'VALUE (IDENT_STR("_BC")) /= BC THEN
 287                FAILED ( "NO EXCEPTION RAISED - " &
 288                         "LEADING UNDERSCORE - 1" );
 289           ELSE
 290                FAILED ( "NO EXCEPTION RAISED - " &
 291                         "LEADING UNDERSCORE - 2" );
 292           END IF;
 293      EXCEPTION
 294           WHEN CONSTRAINT_ERROR =>
 295                NULL;
 296           WHEN OTHERS =>
 297                FAILED ( "WRONG EXCEPTION RAISED - " &
 298                         "LEADING UNDERSCORE" );
 299      END;
 300
 301      BEGIN
 302           IF SUBENUM'VALUE (IDENT_STR("0BC")) /= BC THEN
 303                FAILED ( "NO EXCEPTION RAISED - " &
 304                         "FIRST CHARACTER IS A DIGIT - 1" );
 305           ELSE
 306                FAILED ( "NO EXCEPTION RAISED - " &
 307                         "FIRST CHARACTER IS A DIGIT - 2" );
 308           END IF;
 309      EXCEPTION
 310           WHEN CONSTRAINT_ERROR =>
 311                NULL;
 312           WHEN OTHERS =>
 313                FAILED ( "WRONG EXCEPTION RAISED - " &
 314                         "FIRST CHARACTER IS A DIGIT" );
 315      END;
 316
 317      RESULT;
 318 END C35502C;