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

   1 -- CE3704N.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 -- OBJECTIVE:
  26 --     CHECK THAT GET FOR INTEGER_IO RAISES DATA_ERROR WHEN:
  27 --     (A) BASE LESS THAN 2 OR GREATER THAN 16
  28 --     (B) THE LETTERS IN BASE ARE OUT OF THE BASE RANGE
  29 --     (C) THERE IS NO CLOSING '#' SIGN FOR A BASED LITERAL
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
  33 --     SUPPORT TEXT FILES.
  34
  35 -- HISTORY:
  36 --     VKG 02/10/83
  37 --     SPS 03/16/83
  38 --     CPP 07/30/84
  39 --     RJW 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  40 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  41 --     DWC 09/11/87  REMOVED UNNECESSARY CODE, CORRECTED
  42 --                   EXCEPTION HANDLING, AND CHECKED FOR
  43 --                   USE_ERROR ON DELETE.
  44
  45 WITH TEXT_IO; USE TEXT_IO;
  46 WITH REPORT ; USE REPORT ;
  47
  48 PROCEDURE CE3704N IS
  49      INCOMPLETE : EXCEPTION;
  50
  51 BEGIN
  52      TEST ("CE3704N" ,"CHECK THAT DATA_ERROR IS RAISED WHEN " &
  53                       "A BASED LITERAL DOES NOT HAVE ITS BASE " &
  54                       "IN THE RANGE 2 .. 16, DIGIT IS OUTSIDE " &
  55                       "THE BASE RANGE, OR THERE IS NO CLOSING " &
  56                       "'#' SIGN");
  57
  58      DECLARE
  59           FT : FILE_TYPE;
  60      BEGIN
  61           BEGIN
  62                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
  63           EXCEPTION
  64                WHEN USE_ERROR =>
  65                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
  66                                     "WITH OUT_FILE MODE");
  67                     RAISE INCOMPLETE;
  68                WHEN NAME_ERROR =>
  69                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
  70                                     "WITH OUT_FILE MODE");
  71                     RAISE INCOMPLETE;
  72           END;
  73
  74           PUT (FT, "1#0000#");
  75           NEW_LINE (FT);
  76           PUT (FT, "A#234567#");
  77           NEW_LINE (FT);
  78           PUT (FT, "17#123#1");
  79           NEW_LINE (FT);
  80           PUT (FT, "5#1253#2");
  81           NEW_LINE (FT);
  82           PUT (FT, "8#123");
  83           CLOSE (FT);
  84
  85           DECLARE
  86                PACKAGE INT_IO IS NEW INTEGER_IO(INTEGER);
  87                USE INT_IO;
  88                X : INTEGER := 1003;
  89                CH : CHARACTER;
  90           BEGIN
  91                BEGIN
  92                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
  93                EXCEPTION
  94                     WHEN USE_ERROR =>
  95                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
  96                                          "OPEN WITH IN_FILE MODE");
  97                          RAISE INCOMPLETE;
  98                END;
  99
 100                BEGIN
 101                     GET (FT, X);
 102                     FAILED ("DATA_ERROR NOT RAISED - (1)");
 103                EXCEPTION
 104                     WHEN DATA_ERROR =>
 105                          IF X /= 1003 THEN
 106                               FAILED ("ACTUAL PARAMETER TO GET " &
 107                                       "AFFECTED ON DATA_ERROR");
 108                          END IF;
 109                     WHEN OTHERS =>
 110                          FAILED ("WRONG EXCEPTION RAISED - (1)");
 111                END;
 112
 113                IF NOT END_OF_LINE (FT) THEN
 114                     GET (FT, CH);
 115                     FAILED ("GET STOPPED AT WRONG POSITION - " &
 116                             "(1): CHAR IS " & CH);
 117                END IF;
 118
 119                SKIP_LINE (FT);
 120
 121                BEGIN
 122                     GET (FT, X);
 123                     FAILED ("DATA_ERROR NOT RAISED - (2)");
 124                EXCEPTION
 125                     WHEN DATA_ERROR =>
 126                          IF X /= 1003 THEN
 127                               FAILED ("ACTUAL PARAMETER TO GET " &
 128                                       "AFFECTED ON DATA_ERROR - (2)");
 129                          END IF;
 130                     WHEN OTHERS =>
 131                          FAILED ("WRONG EXCEPTION RAISED - (2)");
 132                END;
 133
 134                IF END_OF_LINE (FT) THEN
 135                     FAILED ("GET STOPPED AT END OF LINE - (2)");
 136                ELSE
 137                     GET (FT, CH);
 138                     IF CH /= 'A' THEN
 139                          FAILED ("GET STOPPED AT WRONG POSITION " &
 140                                  "- (2): CHAR IS " & CH);
 141                          END IF;
 142                END IF;
 143
 144                SKIP_LINE (FT);
 145
 146                BEGIN
 147                     GET (FT, X);
 148                     FAILED ("DATA_ERROR NOT RAISED - (2A)");
 149                EXCEPTION
 150                     WHEN DATA_ERROR =>
 151                          IF X /= 1003 THEN
 152                               FAILED ("ACTUAL PARAMETER TO GET " &
 153                                       "AFFECTED ON DATA_ERROR - (2A)");
 154                          END IF;
 155                     WHEN OTHERS =>
 156                          FAILED ("WRONG EXCEPTION RAISED - (2A)");
 157                END;
 158
 159                IF NOT END_OF_LINE (FT) THEN
 160                     GET (FT, CH);
 161                     IF CH /= '1' THEN
 162                          FAILED ("GET STOPPED AT WRONG POSITION " &
 163                                  "- (2A): CHAR IS " & CH);
 164                     END IF;
 165                END IF;
 166
 167                SKIP_LINE (FT);
 168
 169                BEGIN
 170                     GET (FT, X);
 171                     FAILED ("DATA_ERROR NOT RAISED - (3)");
 172                EXCEPTION
 173                     WHEN DATA_ERROR =>
 174                          IF X /= 1003 THEN
 175                               FAILED ("ACTUAL PARAMETER TO GET " &
 176                                       "AFFECTED ON DATA_ERROR - (3)");
 177                          END IF;
 178                     WHEN OTHERS =>
 179                          FAILED ("WRONG EXCEPTION RAISED - (3)");
 180                END;
 181
 182                IF NOT END_OF_LINE (FT) THEN
 183                     GET (FT, CH);
 184                     IF CH /= '2' THEN
 185                          FAILED ("GET STOPPED AT WRONG POSITION - " &
 186                                  "(3): CHAR IS " & CH);
 187                     END IF;
 188                END IF;
 189
 190                SKIP_LINE (FT);
 191
 192                BEGIN
 193                     GET (FT, X);
 194                     FAILED ("DATA_ERROR NOT RAISED - (4)");
 195                EXCEPTION
 196                     WHEN DATA_ERROR =>
 197                          IF X /= 1003 THEN
 198                               FAILED ("ACTUAL PARAMETER TO GET " &
 199                                       "AFFECTED ON DATA_ERROR - (4)");
 200                          END IF;
 201                     WHEN OTHERS =>
 202                          FAILED ("WRONG EXCEPTION RAISED - (4)");
 203                END;
 204
 205                IF NOT END_OF_LINE (FT) THEN
 206                     GET (FT, CH);
 207                     IF CH /= ' ' THEN
 208                          FAILED ("GET STOPPED AT WRONG POSITION " &
 209                                  "- (4): CHAR IS " & CH);
 210                     END IF;
 211                END IF;
 212
 213           END;
 214
 215           BEGIN
 216                DELETE (FT);
 217           EXCEPTION
 218                WHEN USE_ERROR =>
 219                     NULL;
 220           END;
 221
 222      EXCEPTION
 223           WHEN INCOMPLETE =>
 224                NULL;
 225      END;
 226
 227      RESULT;
 228
 229 END CE3704N;