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

   1 -- C35502K.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 'POS' AND 'VAL' YIELD THE CORRECT RESULTS WHEN
  26 -- THE PREFIX IS AN ENUMERATION TYPE OTHER THAN  A BOOLEAN OR A
  27 -- CHARACTER TYPE.
  28
  29 -- RJW 5/27/86
  30 -- GMT 7/02/87  ADDED ENUM'VAL(3) CHECK NEAR END OF 2ND BLOCK STATEMENT.
  31
  32
  33 WITH REPORT; USE REPORT;
  34
  35 PROCEDURE C35502K IS
  36
  37      TYPE ENUM IS (A, BC, ABC, A_B_C, ABCD);
  38      SUBTYPE SUBENUM IS ENUM RANGE A .. BC;
  39
  40      TYPE NEWENUM IS NEW ENUM;
  41      SUBTYPE SUBNEW IS NEWENUM RANGE A .. BC;
  42
  43 BEGIN
  44      TEST ("C35502K", "CHECK THAT 'POS' AND 'VAL' YIELD THE " &
  45                       "CORRECT RESULTS WHEN THE PREFIX IS AN " &
  46                       "ENUMERATION TYPE OTHER THAN A CHARACTER " &
  47                       "OR A BOOLEAN TYPE" );
  48
  49      DECLARE
  50           POSITION : INTEGER;
  51      BEGIN
  52           POSITION := 0;
  53
  54           FOR E IN ENUM LOOP
  55                IF SUBENUM'POS (E) /= POSITION THEN
  56                     FAILED ( "INCORRECT SUBENUM'POS (" &
  57                               ENUM'IMAGE (E) & ")" );
  58                END IF;
  59
  60                IF SUBENUM'VAL (POSITION) /= E THEN
  61                     FAILED ( "INCORRECT SUBENUM'VAL (" &
  62                               INTEGER'IMAGE (POSITION) &
  63                              ")" );
  64                END IF;
  65
  66                POSITION := POSITION + 1;
  67           END LOOP;
  68
  69           POSITION := 0;
  70           FOR E IN NEWENUM LOOP
  71                IF SUBNEW'POS (E) /= POSITION THEN
  72                     FAILED ( "INCORRECT SUBNEW'POS (" &
  73                               NEWENUM'IMAGE (E) & ")" );
  74                END IF;
  75
  76                IF SUBNEW'VAL (POSITION) /= E THEN
  77                     FAILED ( "INCORRECT SUBNEW'VAL (" &
  78                               INTEGER'IMAGE (POSITION) &
  79                              ")" );
  80                END IF;
  81
  82                POSITION := POSITION + 1;
  83           END LOOP;
  84      END;
  85
  86      DECLARE
  87           FUNCTION A_B_C RETURN ENUM IS
  88           BEGIN
  89                RETURN ENUM'VAL (IDENT_INT (0));
  90           END A_B_C;
  91
  92      BEGIN
  93           IF ENUM'VAL (0) /= A_B_C THEN
  94                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
  95                         "BY FUNCTION - 1" );
  96           END IF;
  97
  98           IF ENUM'VAL (0) = C35502K.A_B_C THEN
  99                FAILED ( "WRONG ENUM'VAL (0) WHEN HIDDEN " &
 100                         "BY FUNCTION - 2" );
 101           END IF;
 102
 103           IF ENUM'VAL (3) /= C35502K.A_B_C THEN
 104                FAILED ( "WRONG ENUM'VAL (3) WHEN HIDDEN " &
 105                         "BY FUNCTION - 3" );
 106           END IF;
 107      END;
 108
 109      BEGIN
 110           IF ENUM'VAL (IDENT_INT (-1)) = A THEN
 111                FAILED ( "NO EXCEPTION RAISED " &
 112                         "FOR ENUM'VAL (IDENT_INT (-1)) - 1" );
 113           ELSE
 114                FAILED ( "NO EXCEPTION RAISED " &
 115                         "FOR ENUM'VAL (IDENT_INT (-1)) - 2" );
 116           END IF;
 117      EXCEPTION
 118           WHEN CONSTRAINT_ERROR =>
 119                NULL;
 120           WHEN OTHERS =>
 121                FAILED ( "WRONG EXCEPTION RAISED " &
 122                         "FOR ENUM'VAL (IDENT_INT (-1))" );
 123      END;
 124
 125      BEGIN
 126           IF NEWENUM'VAL (IDENT_INT (-1)) = A THEN
 127                FAILED ( "NO EXCEPTION RAISED FOR " &
 128                         "NEWENUM'VAL (IDENT_INT (-1)) - 1" );
 129           ELSE
 130                FAILED ( "NO EXCEPTION RAISED FOR " &
 131                         "NEWENUM'VAL (IDENT_INT (-1)) - 2" );
 132           END IF;
 133      EXCEPTION
 134           WHEN CONSTRAINT_ERROR =>
 135                NULL;
 136           WHEN OTHERS =>
 137                FAILED ( "WRONG EXCEPTION RAISED FOR " &
 138                         "NEWENUM'VAL (IDENT_INT (-1))" );
 139      END;
 140
 141      BEGIN
 142           IF ENUM'VAL (IDENT_INT (5)) = A THEN
 143                FAILED ( "NO EXCEPTION RAISED " &
 144                         "FOR ENUM'VAL (IDENT_INT (5)) - 1" );
 145           ELSE
 146                FAILED ( "NO EXCEPTION RAISED " &
 147                         "FOR ENUM'VAL (IDENT_INT (5)) - 2" );
 148           END IF;
 149      EXCEPTION
 150           WHEN CONSTRAINT_ERROR =>
 151                NULL;
 152           WHEN OTHERS =>
 153                FAILED ( "WRONG EXCEPTION RAISED " &
 154                         "FOR ENUM'VAL (IDENT_INT (5))" );
 155      END;
 156
 157      BEGIN
 158           IF NEWENUM'VAL (IDENT_INT (5)) = A THEN
 159                FAILED ( "NO EXCEPTION RAISED FOR " &
 160                         "NEWENUM'VAL (IDENT_INT (5)) - 1" );
 161           ELSE
 162                FAILED ( "NO EXCEPTION RAISED FOR " &
 163                         "NEWENUM'VAL (IDENT_INT (5)) - 2" );
 164           END IF;
 165      EXCEPTION
 166           WHEN CONSTRAINT_ERROR =>
 167                NULL;
 168           WHEN OTHERS =>
 169                FAILED ( "WRONG EXCEPTION RAISED FOR " &
 170                         "NEWENUM'VAL (IDENT_INT (5))" );
 171      END;
 172
 173      RESULT;
 174 END C35502K;