gcc/testsuite/ada/acats/tests/ce/ce3809b.ada

   1 -- CE3809B.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 -- HISTORY:
  26 --     CHECK THAT FIXED I/O GET CAN READ A VALUE FROM A STRING.
  27 --     CHECK THAT END_ERROR IS RAISED WHEN CALLED WITH A NULL STRING
  28 --     OR A STRING CONTAINING SPACES AND/OR HORIZONTAL TABULATION
  29 --     CHARACTERS.  CHECK THAT LAST CONTAINS THE INDEX OF THE LAST
  30 --     CHARACTER READ FROM THE STRING.
  31
  32 -- HISTORY:
  33 --     SPS 10/07/82
  34 --     SPS 12/14/82
  35 --     JBG 12/21/82
  36 --     DWC 09/15/87  ADDED CASE TO INCLUDE ONLY TABS IN STRING AND
  37 --                   CHECKED THAT END_ERROR IS RAISED.
  38
  39 WITH REPORT; USE REPORT;
  40 WITH TEXT_IO; USE TEXT_IO;
  41
  42 PROCEDURE CE3809B IS
  43 BEGIN
  44
  45      TEST ("CE3809B", "CHECK THAT FIXED_IO GET " &
  46                       "OPERATES CORRECTLY ON STRINGS");
  47
  48      DECLARE
  49           TYPE FX IS DELTA 0.001 RANGE -2.0 .. 1000.0;
  50           PACKAGE FXIO IS NEW FIXED_IO (FX);
  51           USE FXIO;
  52           X : FX;
  53           L : POSITIVE;
  54           STR : STRING (1..10) := "   10.25  ";
  55      BEGIN
  56
  57 -- LEFT-JUSTIFIED IN STRING, POSITIVE, NO EXPONENT
  58           BEGIN
  59                GET ("896.5  ", X, L);
  60                IF X /= 896.5 THEN
  61                     FAILED ("FIXED VALUE FROM STRING INCORRECT");
  62                END IF;
  63           EXCEPTION
  64                WHEN DATA_ERROR =>
  65                     FAILED ("DATA_ERROR RAISED - FIXED - 1");
  66                WHEN OTHERS =>
  67                     FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 1");
  68           END;
  69
  70           IF L /= IDENT_INT (5) THEN
  71                FAILED ("VALUE OF LAST INCORRECT - FIXED - 1.  " &
  72                        "LAST IS" & INTEGER'IMAGE(L));
  73           END IF;
  74
  75 -- STRING LITERAL WITH BLANKS
  76           BEGIN
  77                GET ("   ", X, L);
  78                FAILED ("END_ERROR NOT RAISED - FIXED - 2");
  79           EXCEPTION
  80                WHEN END_ERROR =>
  81                     IF L /= 5 THEN
  82                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
  83                                  "INCORRECT - 2.  LAST IS"  &
  84                                  INTEGER'IMAGE(L));
  85                     END IF;
  86                WHEN DATA_ERROR =>
  87                     FAILED ("DATA_ERROR RAISED - FIXED - 2");
  88                WHEN OTHERS =>
  89                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 2");
  90           END;
  91
  92 -- NULL STRING LITERAL
  93           BEGIN
  94                GET ("", X, L);
  95                FAILED ("END_ERROR NOT RAISED - FIXED - 3");
  96           EXCEPTION
  97                WHEN END_ERROR =>
  98                     IF L /= 5 THEN
  99                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
 100                                  "INCORRECT - 3.  LAST IS"  &
 101                                  INTEGER'IMAGE(L));
 102                     END IF;
 103                WHEN DATA_ERROR =>
 104                     FAILED ("DATA_ERROR RAISED - FIXED - 3");
 105                WHEN OTHERS =>
 106                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 3");
 107           END;
 108
 109 -- NULL SLICE
 110           BEGIN
 111                GET (STR(5..IDENT_INT(2)), X, L);
 112                FAILED ("END_ERROR NOT RAISED - FIXED - 4");
 113           EXCEPTION
 114                WHEN END_ERROR =>
 115                     IF L /= 5 THEN
 116                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
 117                                  "INCORRECT - 4.  LAST IS"  &
 118                                  INTEGER'IMAGE(L));
 119                     END IF;
 120                WHEN DATA_ERROR =>
 121                     FAILED ("DATA_ERROR RAISED - FIXED - 4");
 122                WHEN OTHERS =>
 123                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 4");
 124           END;
 125
 126 -- SLICE WITH BLANKS
 127           BEGIN
 128                GET (STR(IDENT_INT(9)..10), X, L);
 129                FAILED ("END_ERROR NOT RAISED - FIXED - 5");
 130           EXCEPTION
 131                WHEN END_ERROR =>
 132                     IF L /= IDENT_INT(5) THEN
 133                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
 134                                  "INCORRECT - 5.  LAST IS"  &
 135                                  INTEGER'IMAGE(L));
 136                     END IF;
 137                WHEN DATA_ERROR =>
 138                     FAILED ("DATA_ERROR RAISED - FIXED - 5");
 139                WHEN OTHERS =>
 140                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 5");
 141           END;
 142
 143 -- NON-NULL SLICE
 144           BEGIN
 145                GET (STR(2..IDENT_INT(8)), X, L);
 146                IF X /= 10.25 THEN
 147                     FAILED ("FIXED VALUE INCORRECT - 6");
 148                END IF;
 149                IF L /= 8 THEN
 150                     FAILED ("LAST INCORRECT FOR SLICE - 6.  " &
 151                             "LAST IS" & INTEGER'IMAGE(L));
 152                END IF;
 153           EXCEPTION
 154                WHEN OTHERS =>
 155                     FAILED ("EXCEPTION RAISED - 6");
 156           END;
 157
 158 -- LEFT-JUSTIFIED, POSITIVE EXPONENT
 159           BEGIN
 160                GET ("1.34E+02", X, L);
 161                IF X /= 134.0 THEN
 162                     FAILED ("FIXED WITH EXP FROM STRING INCORRECT - 7");
 163                END IF;
 164
 165                IF L /= 8 THEN
 166                     FAILED ("VALUE OF LAST INCORRECT - FIXED - 7.  " &
 167                             "LAST IS" & INTEGER'IMAGE(L));
 168                END IF;
 169           EXCEPTION
 170                WHEN DATA_ERROR =>
 171                     FAILED ("DATA_EROR RAISED - FIXED - 7");
 172                WHEN OTHERS =>
 173                     FAILED ("UNEXPECTED EXCEPTION RAISED - FIXED - 7");
 174           END;
 175
 176 -- RIGHT-JUSTIFIED, NEGATIVE EXPONENT
 177           BEGIN
 178                GET (" 25.0E-2", X, L);
 179                IF X /= 0.25 THEN
 180                     FAILED ("NEG EXPONENT INCORRECT - 8");
 181                END IF;
 182                IF L /= 8 THEN
 183                     FAILED ("LAST INCORRECT - 8.  " &
 184                             "LAST IS" & INTEGER'IMAGE(L));
 185                END IF;
 186           EXCEPTION
 187                WHEN OTHERS =>
 188                     FAILED ("EXCEPTION RAISED - 8");
 189           END;
 190
 191 -- RIGHT-JUSTIFIED, NEGATIVE
 192           GET ("  -1.50", X, L);
 193           IF X /= -1.5 THEN
 194                FAILED ("FIXED IN RIGHT JUSTIFIED STRING INCORRECT - 9");
 195           END IF;
 196           IF L /= 7 THEN
 197                FAILED ("LAST INCORRECT - 9.  " &
 198                        "LAST IS" & INTEGER'IMAGE(L));
 199           END IF;
 200
 201 -- HORIZONTAL TAB WITH BLANK
 202           BEGIN
 203                GET (" " & ASCII.HT & "2.3E+2", X, L);
 204                IF X /= 230.0 THEN
 205                     FAILED ("FIXED WITH TAB IN STRING INCORRECT - 10");
 206                END IF;
 207                IF L /= 8 THEN
 208                     FAILED ("LAST INCORRECT FOR TAB - 10.  " &
 209                             "LAST IS" & INTEGER'IMAGE(L));
 210                END IF;
 211           EXCEPTION
 212                WHEN DATA_ERROR =>
 213                     FAILED ("DATA_ERROR FOR STRING WITH TAB - 10");
 214                WHEN OTHERS =>
 215                     FAILED ("EXCEPTION FOR STRING WITH TAB - 10");
 216           END;
 217
 218 -- HORIZONTAL TABS ONLY
 219
 220           BEGIN
 221                GET (ASCII.HT & ASCII.HT, X, L);
 222                FAILED ("END_ERROR NOT RAISED - FIXED - 11");
 223           EXCEPTION
 224                WHEN END_ERROR =>
 225                     IF L /= IDENT_INT(8) THEN
 226                          FAILED ("AFTER END_ERROR, VALUE OF LAST " &
 227                                  "INCORRECT - 11.  LAST IS"  &
 228                                  INTEGER'IMAGE(L));
 229                     END IF;
 230                WHEN DATA_ERROR =>
 231                     FAILED ("DATA_ERROR RAISED - FIXED - 11");
 232                WHEN OTHERS =>
 233                     FAILED ("WRONG EXCEPTION RAISED - FIXED - 11");
 234           END;
 235      END;
 236
 237      RESULT;
 238
 239 END CE3809B;