gomp-20050608-branch/gcc/testsuite/ada/acats/tests/c3/c35508c.ada

   1 -- C35508C.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 A BOOLEAN TYPE.
  27
  28 -- SUBTESTS ARE:
  29 --     (A). TESTS FOR IMAGE.
  30 --     (B). TESTS FOR VALUE.
  31
  32 -- RJW 3/19/86
  33
  34 WITH REPORT; USE REPORT;
  35
  36 PROCEDURE  C35508C  IS
  37
  38      TYPE NEWBOOL IS NEW BOOLEAN;
  39
  40 BEGIN
  41
  42      TEST( "C35508C" , "CHECK THAT THE ATTRIBUTES 'IMAGE' AND " &
  43                        "'VALUE' YIELD THE CORRECT RESULTS WHEN THE " &
  44                        "PREFIX IS A BOOLEAN TYPE" );
  45 -- PART (A).
  46
  47      DECLARE
  48
  49           A5, B5 : INTEGER := IDENT_INT(5);
  50           C6     : INTEGER := IDENT_INT(6);
  51      BEGIN
  52
  53           IF BOOLEAN'IMAGE ( A5 = B5 ) /= "TRUE" THEN
  54                FAILED ( "INCORRECT IMAGE FOR 'A5 = B5'" );
  55           END IF;
  56           IF BOOLEAN'IMAGE ( A5 = B5 )'FIRST /= 1 THEN
  57                FAILED ( "INCORRECT LOWER BOUND FOR 'A5 = B5'" );
  58           END IF;
  59
  60           IF BOOLEAN'IMAGE ( C6 = A5 ) /= "FALSE" THEN
  61                FAILED ( "INCORRECT IMAGE FOR 'C6 = A5'" );
  62           END IF;
  63           IF BOOLEAN'IMAGE ( C6 = A5 )'FIRST /= 1 THEN
  64                FAILED ( "INCORRECT LOWER BOUND FOR 'C6 = A5'" );
  65           END IF;
  66
  67           IF BOOLEAN'IMAGE (TRUE) /= "TRUE" THEN
  68                FAILED ( "INCORRECT IMAGE FOR 'TRUE'" );
  69           END IF;
  70           IF BOOLEAN'IMAGE (TRUE)'FIRST /= 1 THEN
  71                FAILED ( "INCORRECT LOWER BOUND FOR 'TRUE'" );
  72           END IF;
  73
  74           IF NEWBOOL'IMAGE (FALSE) /= "FALSE" THEN
  75                FAILED ( "INCORRECT IMAGE FOR NEWBOOL'FALSE'" );
  76           END IF;
  77           IF NEWBOOL'IMAGE (FALSE)'FIRST /= 1 THEN
  78                FAILED ( "INCORRECT LOWER BOUND FOR NEWBOOL'FALSE'" );
  79           END IF;
  80      END;
  81
  82 -----------------------------------------------------------------------
  83
  84 -- PART (B).
  85
  86      BEGIN
  87           IF BOOLEAN'VALUE (IDENT_STR("TRUE")) /= TRUE THEN
  88                FAILED ( "INCORRECT VALUE FOR ""TRUE""" );
  89           END IF;
  90      EXCEPTION
  91           WHEN OTHERS =>
  92                FAILED ( "EXCEPTION RAISED - VALUE FOR ""TRUE""" );
  93      END;
  94
  95      BEGIN
  96           IF NEWBOOL'VALUE (IDENT_STR("FALSE")) /= FALSE THEN
  97                FAILED ( "INCORRECT VALUE FOR ""FALSE""" );
  98           END IF;
  99      EXCEPTION
 100           WHEN OTHERS =>
 101                FAILED ( "EXCEPTION RAISED - VALUE FOR ""FALSE""" );
 102      END;
 103
 104      BEGIN
 105           IF BOOLEAN'VALUE ("true") /= TRUE THEN
 106                FAILED ( "INCORRECT VALUE FOR ""true""" );
 107           END IF;
 108      EXCEPTION
 109           WHEN OTHERS =>
 110                FAILED ( "EXCEPTION RAISED - VALUE FOR ""true""" );
 111      END;
 112
 113      BEGIN
 114           IF NEWBOOL'VALUE ("false") /= FALSE THEN
 115                FAILED ( "INCORRECT VALUE FOR ""false""" );
 116           END IF;
 117      EXCEPTION
 118           WHEN OTHERS =>
 119                FAILED ( "EXCEPTION RAISED - VALUE FOR " &
 120                         """false""" );
 121      END;
 122
 123      BEGIN
 124           IF BOOLEAN'VALUE (IDENT_STR("TRUE     ")) /= TRUE THEN
 125                FAILED ( "INCORRECT VALUE WITH TRAILING BLANKS" );
 126           END IF;
 127      EXCEPTION
 128           WHEN OTHERS =>
 129                FAILED ( "EXCEPTION RAISED - VALUE - " &
 130                         "TRAILING BLANKS" );
 131      END;
 132
 133      BEGIN
 134           IF NEWBOOL'VALUE ("  FALSE") /= FALSE THEN
 135                FAILED ( "INCORRECT VALUE WITH LEADING BLANKS" );
 136           END IF;
 137      EXCEPTION
 138           WHEN OTHERS =>
 139                FAILED ( "EXCEPTION RAISED - VALUE - LEADING " &
 140                         "BLANKS" );
 141      END;
 142
 143      DECLARE
 144           SUBTYPE SUBBOOL IS BOOLEAN RANGE FALSE .. FALSE;
 145      BEGIN
 146           IF SUBBOOL'VALUE (IDENT_STR("TRUE")) /= TRUE THEN
 147                FAILED ( "INCORRECT VALUE - ""TRUE"" AND " &
 148                         "SUBBOOL" );
 149           END IF;
 150      EXCEPTION
 151           WHEN OTHERS =>
 152                FAILED ( "EXCEPTION RAISED - SUBBOOL" );
 153      END;
 154
 155      BEGIN
 156           IF BOOLEAN'VALUE (IDENT_STR("MAYBE")) = TRUE THEN
 157                FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 1" );
 158           ELSE
 159                FAILED ( "NO EXCEPTION RAISED - ""MAYBE"" - 2" );
 160           END IF;
 161      EXCEPTION
 162           WHEN CONSTRAINT_ERROR =>
 163                NULL;
 164           WHEN OTHERS =>
 165                FAILED ( "WRONG EXCEPTION RAISED - ""MAYBE"" " );
 166      END;
 167
 168      BEGIN
 169           IF BOOLEAN'VALUE (IDENT_CHAR(ASCII.HT) & "TRUE") = TRUE THEN
 170                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 1" );
 171           ELSE
 172                FAILED ( "NO EXCEPTION RAISED - LEADING 'HT' - 2" );
 173           END IF;
 174      EXCEPTION
 175           WHEN CONSTRAINT_ERROR =>
 176                NULL;
 177           WHEN OTHERS =>
 178                FAILED ( "WRONG EXCEPTION RAISED - LEADING 'HT'" );
 179      END;
 180
 181      BEGIN
 182           IF NEWBOOL'VALUE ("FALSE" & ASCII.HT) = FALSE THEN
 183                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 1" );
 184           ELSE
 185                FAILED ( "NO EXCEPTION RAISED - TRAILING 'HT' - 2" );
 186           END IF;
 187      EXCEPTION
 188           WHEN CONSTRAINT_ERROR =>
 189                NULL;
 190           WHEN OTHERS =>
 191                FAILED ( "WRONG EXCEPTION RAISED - TRAILING 'HT'" );
 192      END;
 193
 194      RESULT;
 195 END C35508C;