old-autovect-branch/gcc/testsuite/ada/acats/tests/c4/c45201b.ada

   1 -- C45201B.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 ORDERING OF ENUMERATION LITERALS AS DEFINED BY THE
  26 --    ORDERING OPERATORS IS THE SAME AS THE ORDER OF OCCURRENCE OF THE
  27 --    LITERALS IN THE TYPE DEFINITION.
  28
  29 -- THIS TEST IS DERIVED FROM  C45210A.ADA .
  30
  31
  32 -- RM    17 OCTOBER 1980
  33 -- JWC 7/8/85   RENAMED TO -AB
  34
  35
  36 WITH  REPORT ;
  37 PROCEDURE  C45201B  IS
  38
  39      USE REPORT;
  40
  41      TYPE  T  IS  ( A , SLIT , B , PLIT , C , NUL , D , 'R' , E );
  42
  43      --                 S-LIT ,    P-LIT ,    NUL ,     'R'   CORRESPOND
  44      --            TO    'S'  ,     'P'  ,    'M'  ,    'R'  IN C45210A.
  45
  46      SUBTYPE  T1  IS  T RANGE A..B ;
  47      SUBTYPE  T2  IS  T RANGE A..C ;    -- INCLUDES  T1
  48      SUBTYPE  T3  IS  T RANGE B..D ;    -- INTERSECTS  T2 , T4
  49      SUBTYPE  T4  IS  T RANGE C..E ;    -- DISJOINT FROM  T1 , T2
  50
  51      MVAR  : T3 := T'(NUL ) ;
  52      PVAR  : T2 := T'(PLIT) ;
  53      RVAR  : T4 := T'('R' ) ;
  54      SVAR  : T1 := T'(SLIT) ;
  55
  56      ERROR_COUNT : INTEGER := 0 ;   -- INITIAL VALUE ESSENTIAL
  57
  58      PROCEDURE  BUMP  IS
  59      BEGIN
  60           ERROR_COUNT := ERROR_COUNT + 1 ;
  61      END BUMP ;
  62
  63
  64 BEGIN
  65
  66      TEST( "C45201B","CHECK THAT THE ORDERING OF ENUMERATION LITERALS "&
  67                      " AS DEFINED BY THE ORDERING OPERATORS" &
  68                      " IS THE SAME AS THE ORDER OF OCCURRENCE OF THE " &
  69                      " LITERALS IN THE TYPE DEFINITION" ) ;
  70
  71      -- 256 CASES ( 4 * 4  ORDERED PAIRS OF OPERAND VALUES,
  72      --               4    ORDERING OPERATORS: '<' , '<=' , '>' , '>='
  73      --                         (IN THE TABLE:  A  ,  B   ,  C  ,  D   )
  74      --               4    VARIABLE/LITERAL FOR LEFT OPERAND,
  75      --                    VARIABLE/LITERAL FOR RIGHT OPERAND,
  76      --                         (IN THE TABLE:  VV = ALPHA ,
  77      --                                         VL = BETA  ,
  78      --                                         LV = GAMMA ,
  79      --                                         LL = DELTA  ) RANDOMIZED
  80      --    INTO 16 (ONE FOR EACH PAIR OF VALUES) ACCORDING TO THE FOL-
  81      --    LOWING GRAECO-LATIN SQUARE (WITH ADDITIONAL PROPERTIES):
  82
  83      --               RIGHT OPERAND:    'S'      'P'      'M'      'R'
  84      --         LEFT
  85      --       OPERAND:
  86
  87      --         'S'                   A-ALPHA  B-BETA   C-GAMMA  D-DELTA
  88      --         'P'                   C-DELTA  D-GAMMA  A-BETA   B-ALPHA
  89      --         'M'                   D-BETA   C-ALPHA  B-DELTA  A-GAMMA
  90      --         'R'                   B-GAMMA  A-DELTA  D-ALPHA  C-BETA
  91
  92      --    (BOTH THE LATIN DIAGONAL AND THE GREEK DIAGONAL CONTAIN 4
  93      --    DISTINCT LETTERS, NON-TRIVIALLY PERMUTED.)
  94
  95      -- THE ABOVE DESCRIBES  PART 1  OF THE TEST.  PART 2  PERFORMS AN
  96      --    EXHAUSTIVE VERIFICATION OF THE 'VARIABLE VS. VARIABLE' CASE
  97      --    ( VV , ALPHA ) FOR ALL 4 OPERATORS.
  98
  99     -----------------------------------------------------------------
 100
 101      -- PART 1
 102
 103      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT'
 104
 105      IF  T'(SVAR) <  T'(SVAR)  THEN  BUMP ;               END IF;
 106      IF  T'(SVAR) <= T'(PLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
 107      IF  T'(SLIT) >  T'(MVAR)  THEN  BUMP ;               END IF;
 108      IF  T'(SLIT) >= T'('R' )  THEN  BUMP ;               END IF;
 109
 110      IF  T'(PLIT) >  T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
 111      IF  T'(PLIT) >= T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
 112      IF  T'(PVAR) <  T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
 113      IF  T'(PVAR) <= T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
 114
 115      IF  T'(MVAR) >= T'(SLIT)  THEN  NULL;  ELSE  BUMP ;  END IF;
 116      IF  T'(MVAR) >  T'(PVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
 117      IF  T'(NUL ) <= T'(NUL )  THEN  NULL;  ELSE  BUMP ;  END IF;
 118      IF  T'(NUL ) <  T'(RVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
 119
 120      IF  T'('R' ) <= T'(SVAR)  THEN  BUMP ;               END IF;
 121      IF  T'('R' ) <  T'(PLIT)  THEN  BUMP ;               END IF;
 122      IF  T'(RVAR) >= T'(MVAR)  THEN  NULL;  ELSE  BUMP ;  END IF;
 123      IF  T'(RVAR) >  T'('R' )  THEN  BUMP ;               END IF;
 124
 125
 126      IF  ERROR_COUNT /= 0  THEN
 127           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE1" );
 128      END IF;
 129
 130     -----------------------------------------------------------------
 131
 132      -- PART 2
 133
 134      -- 'BUMP'  MEANS  'INCREASE THE COUNT FOR THE NUMBER OF <TRUE>S'
 135
 136      ERROR_COUNT := 0 ;
 137
 138      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
 139           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
 140
 141                IF  AVAR <  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:=  6
 142
 143           END LOOP;
 144      END LOOP;
 145
 146      IF  ERROR_COUNT /= 6  THEN   -- THIS IS A PLAIN COUNT, NOT AN
 147                                    --    ERROR COUNT
 148           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE2" );
 149      END IF;
 150
 151
 152      ERROR_COUNT := 0 ;
 153
 154      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
 155           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
 156
 157                IF  AVAR <= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 10
 158
 159           END LOOP;
 160      END LOOP;
 161
 162      IF  ERROR_COUNT /=10  THEN   -- THIS IS A PLAIN COUNT, NOT AN
 163                                    --    ERROR COUNT
 164           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE3" );
 165      END IF;
 166
 167
 168      ERROR_COUNT := 0 ;
 169
 170      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
 171           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
 172
 173                IF  AVAR >  BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 26
 174
 175           END LOOP;
 176      END LOOP;
 177
 178      IF  ERROR_COUNT /=26  THEN   -- THIS IS A PLAIN COUNT, NOT AN
 179                                    --    ERROR COUNT
 180           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE4" );
 181      END IF;
 182
 183
 184      ERROR_COUNT := 0 ;
 185
 186      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
 187           FOR  BVAR  IN  T'FIRST..T'(PLIT)  LOOP   -- 4 VALUES
 188
 189                IF  AVAR >= BVAR  THEN  BUMP ;  END IF;   -- COUNT +:= 30
 190
 191           END LOOP;
 192      END LOOP;
 193
 194      IF  ERROR_COUNT /=30  THEN   -- THIS IS A PLAIN COUNT, NOT AN
 195                                    --    ERROR COUNT
 196           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE5" );
 197      END IF;
 198
 199
 200      --  'BUMP'  MEANS  'BUMP THE ERROR COUNT' (AGAIN)
 201
 202      ERROR_COUNT := 0 ;
 203
 204      FOR  AVAR IN  T'FIRST..T'LAST  LOOP           -- 9 VALUES
 205
 206           FOR  BVAR  IN  T'FIRST..T'LAST   LOOP    -- 9 VALUES
 207
 208                IF ( AVAR <  BVAR ) /= ( T'POS(AVAR) <  T'POS(BVAR) )THEN
 209                     BUMP ;
 210                END IF;
 211
 212                IF ( AVAR <= BVAR ) /= ( T'POS(AVAR) <= T'POS(BVAR) )THEN
 213                     BUMP ;
 214                END IF;
 215
 216                IF ( AVAR >  BVAR ) /= ( T'POS(AVAR) >  T'POS(BVAR) )THEN
 217                     BUMP ;
 218                END IF;
 219
 220                IF ( AVAR >= BVAR ) /= ( T'POS(AVAR) >= T'POS(BVAR) )THEN
 221                     BUMP ;
 222                END IF;
 223
 224           END LOOP;
 225
 226      END LOOP;
 227
 228
 229      IF  ERROR_COUNT /= 0  THEN   -- REAL ERROR COUNT AGAIN
 230           FAILED( "ORDERING OF ENUMERATION LITERALS - FAILURE6" );
 231      END IF;
 232
 233
 234      RESULT;
 235
 236 END C45201B;