gcc/testsuite/ada/acats/tests/c4/c41404a.ada

   1 -- C41404A.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 PREFIX OF THE ARRAY ATTRIBUTES CAN BE THE VALUE OF AN
  26 -- IMAGE ATTRIBUTE.
  27
  28 -- JBG 6/1/85
  29 -- PWB 2/3/86  CORRECTED COMPARISON VALUES FOR 'LAST AND 'LENGTH.
  30
  31 WITH REPORT; USE REPORT;
  32 PROCEDURE C41404A IS
  33
  34      TYPE ENUM IS (ONE, FOUR, 'C');
  35
  36 BEGIN
  37
  38      TEST ("C41404A", "CHECK WHEN PREFIX OF AN ATTRIBUTE IS 'IMAGE");
  39
  40      IF ENUM'IMAGE(FOUR)'LENGTH /= IDENT_INT(4) THEN
  41           FAILED ("WRONG VALUE FOR LENGTH - ENUM");
  42      END IF;
  43
  44      IF ENUM'IMAGE('C')'LENGTH /= IDENT_INT(3) THEN
  45           FAILED ("WRONG VALUE FOR LENGTH - ENUM: 'C'");
  46      END IF;
  47
  48      IF INTEGER'IMAGE(IDENT_INT(56))'LENGTH /= IDENT_INT(3) THEN
  49           FAILED ("WRONG VALUE FOR LENGTH - INTEGER: 56");
  50      END IF;
  51
  52      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LENGTH /= IDENT_INT(3) THEN
  53           FAILED ("WRONG VALUE FOR LENGTH - CHAR: 'B'");
  54      END IF;
  55
  56      IF ENUM'IMAGE(FOUR)'FIRST /= IDENT_INT(1) THEN
  57           FAILED ("WRONG VALUE FOR FIRST - ENUM");
  58      END IF;
  59
  60      IF ENUM'IMAGE('C')'FIRST(1) /= IDENT_INT(1) THEN
  61           FAILED ("WRONG VALUE FOR FIRST - ENUM: 'C'");
  62      END IF;
  63
  64      IF INTEGER'IMAGE(IDENT_INT(56))'FIRST /= IDENT_INT(1) THEN
  65           FAILED ("WRONG VALUE FOR FIRST - INTEGER: 56");
  66      END IF;
  67
  68      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'FIRST /= IDENT_INT(1) THEN
  69           FAILED ("WRONG VALUE FOR FIRST - CHAR: 'B'");
  70      END IF;
  71
  72      IF ENUM'IMAGE(FOUR)'LAST /= IDENT_INT(4) THEN
  73           FAILED ("WRONG VALUE FOR LAST - ENUM");
  74      END IF;
  75
  76      IF ENUM'IMAGE('C')'LAST(1) /= IDENT_INT(3) THEN
  77           FAILED ("WRONG VALUE FOR LAST - ENUM: 'C'");
  78      END IF;
  79
  80      IF INTEGER'IMAGE(IDENT_INT(-56))'LAST /= IDENT_INT(3) THEN
  81           FAILED ("WRONG VALUE FOR LAST - INTEGER: -56");
  82      END IF;
  83
  84      IF CHARACTER'IMAGE(IDENT_CHAR('B'))'LAST /= IDENT_INT(3) THEN
  85           FAILED ("WRONG VALUE FOR LAST - CHAR: 'B'");
  86      END IF;
  87
  88      DECLARE
  89
  90           FOUR_VAR : STRING(ENUM'IMAGE(FOUR)'RANGE);
  91           C_VAR    : STRING(ENUM'IMAGE('C')'RANGE);
  92           VAR_101  : STRING(INTEGER'IMAGE(IDENT_INT(101))'RANGE);
  93           CHAR_VAR : STRING(CHARACTER'IMAGE(IDENT_CHAR('B'))'RANGE);
  94
  95      BEGIN
  96
  97           IF FOUR_VAR'FIRST /= 1 OR
  98              FOUR_VAR'LAST  /= 4 OR
  99              FOUR_VAR'LENGTH /= 4 THEN
 100                FAILED ("FOUR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
 101                        INTEGER'IMAGE(FOUR_VAR'FIRST) & ".  LAST IS" &
 102                        INTEGER'IMAGE(FOUR_VAR'LAST) & ".  LENGTH IS" &
 103                        INTEGER'IMAGE(FOUR_VAR'LENGTH));
 104           END IF;
 105
 106           IF C_VAR'FIRST /= 1 OR
 107              C_VAR'LAST  /= 3 OR
 108              C_VAR'LENGTH /= 3 THEN
 109                FAILED ("C_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
 110                        INTEGER'IMAGE(C_VAR'FIRST) & ".  LAST IS" &
 111                        INTEGER'IMAGE(C_VAR'LAST) & ".  LENGTH IS" &
 112                        INTEGER'IMAGE(C_VAR'LENGTH));
 113           END IF;
 114
 115           IF VAR_101'FIRST /= 1 OR
 116              VAR_101'LAST  /= 4 OR
 117              VAR_101'LENGTH /= 4 THEN
 118                FAILED ("VAR_101 ATTRIBUTES INCORRECT.  FIRST IS" &
 119                        INTEGER'IMAGE(VAR_101'FIRST) & ".  LAST IS" &
 120                        INTEGER'IMAGE(VAR_101'LAST) & ".  LENGTH IS" &
 121                        INTEGER'IMAGE(VAR_101'LENGTH));
 122           END IF;
 123
 124           IF CHAR_VAR'FIRST /= 1 OR
 125              CHAR_VAR'LAST  /= 3 OR
 126              CHAR_VAR'LENGTH /= 3 THEN
 127                FAILED ("CHAR_VAR ATTRIBUTES INCORRECT.  FIRST IS" &
 128                        INTEGER'IMAGE(CHAR_VAR'FIRST) & ".  LAST IS" &
 129                        INTEGER'IMAGE(CHAR_VAR'LAST) & ".  LENGTH IS" &
 130                        INTEGER'IMAGE(CHAR_VAR'LENGTH));
 131           END IF;
 132
 133      END;
 134
 135      RESULT;
 136 END C41404A;