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

   1 -- CE3905L.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 DATA_ERROR IS RAISED, BY GET, WHEN THE INPUT CONTAINS
  27 --
  28 --     1. EMBEDDED BLANKS.
  29 --     2. SINGLY QUOTED CHARACTER LITERALS.
  30 --     3. IDENTIFIERS BEGINNING WITH NON LETTERS.
  31 --     4. IDENTIFIERS CONTAINING SPECIAL CHARACTERS.
  32 --     5. CONSECUTIVE UNDERSCORES.
  33 --     6. LEADING OR TRAILING UNDERSCORES.
  34
  35 -- APPLICABILITY CRITERIA:
  36 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
  37 --     SUPPORT TEXT FILES.
  38
  39 -- HISTORY:
  40 --     VKG 02/14/83
  41 --     SPS 03/16/83
  42 --     CPP 07/30/84
  43 --     TBN 11/10/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  44 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  45 --     DWC 09/16/87  REMOVED UNNECESSARY CODE AND CORRECTED
  46 --                   EXCEPTION HANDLING.
  47
  48 WITH TEXT_IO; USE TEXT_IO;
  49 WITH REPORT; USE REPORT;
  50
  51 PROCEDURE CE3905L IS
  52
  53      INCOMPLETE : EXCEPTION;
  54
  55 BEGIN
  56      TEST ("CE3905L", "CHECK GET FOR ENUMERATION_IO " &
  57                       "WITH LEXICAL ERRORS");
  58      DECLARE
  59           FT : FILE_TYPE;
  60      BEGIN
  61
  62           BEGIN
  63                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
  64           EXCEPTION
  65                WHEN USE_ERROR =>
  66                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
  67                                     "WITH OUT_FILE MODE");
  68                     RAISE INCOMPLETE;
  69                WHEN NAME_ERROR =>
  70                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
  71                                     "WITH OUT_FILE MODE");
  72                     RAISE INCOMPLETE;
  73           END;
  74
  75           PUT (FT, "RED ISH");
  76           NEW_LINE (FT);
  77           PUT (FT, "'A ");
  78           NEW_LINE (FT);
  79           PUT (FT, "2REDISH");
  80           NEW_LINE (FT);
  81           PUT (FT, "BLUE$%ISH");
  82           NEW_LINE (FT);
  83           PUT (FT, "RED__ISH");
  84           NEW_LINE (FT);
  85           PUT (FT, "_YELLOWISH");
  86           NEW_LINE (FT);
  87           PUT  (FT, "GREENISH_");
  88           NEW_LINE (FT);
  89
  90           CLOSE (FT);
  91
  92           DECLARE
  93                TYPE COLOUR IS
  94                     ( GREYISH,
  95                       REDISH ,
  96                       BLUEISH,
  97                       YELLOWISH,
  98                       GREENISH, 'A');
  99                PACKAGE COLOUR_IO IS NEW ENUMERATION_IO(COLOUR);
 100                USE COLOUR_IO;
 101                X : COLOUR := GREYISH;
 102                CH : CHARACTER;
 103           BEGIN
 104
 105                BEGIN
 106                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
 107                EXCEPTION
 108                     WHEN USE_ERROR =>
 109                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT " &
 110                                          "OPEN WITH IN_FILE MODE");
 111                          RAISE INCOMPLETE;
 112                END;
 113
 114                BEGIN
 115                     GET (FT, X);
 116                     FAILED ("DATA_ERROR NOT RAISED - 1");
 117                EXCEPTION
 118                     WHEN DATA_ERROR =>
 119                          IF X /= GREYISH THEN
 120                               FAILED ("ACTUAL PARAMETER TO GET " &
 121                                       "AFFECTED ON DATA_ERROR - 1");
 122                          END IF;
 123                     WHEN OTHERS =>
 124                          FAILED ("WRONG EXCEPTION RAISED - 1");
 125                END;
 126
 127                IF END_OF_LINE (FT) THEN
 128                     FAILED ("GET STOPPED AT END OF LINE - 1");
 129                ELSE
 130                     GET (FT, CH);
 131                     IF CH /= ' ' THEN
 132                          FAILED ("GET STOPPED AT WRONG POSITION " &
 133                                  "- 1: CHAR IS " & CH);
 134                     END IF;
 135                END IF;
 136
 137                SKIP_LINE (FT);
 138
 139                BEGIN
 140                     GET (FT, X);
 141                     FAILED ("DATA_ERROR NOT RAISED - 2");
 142                EXCEPTION
 143                     WHEN DATA_ERROR =>
 144                          IF X /= GREYISH THEN
 145                               FAILED ("ACTUAL PARAMETER TO GET " &
 146                                       "AFFECTED ON DATA_ERROR - 2");
 147                          END IF;
 148                     WHEN OTHERS =>
 149                          FAILED ("WRONG EXCEPTION RAISED - 2");
 150                END;
 151
 152                IF END_OF_LINE (FT) THEN
 153                     FAILED ("GET STOPPED AT END OF LINE - 2");
 154                ELSE
 155                     GET (FT, CH);
 156                     IF CH /= ' ' THEN
 157                          FAILED ("GET STOPPED AT WRONG POSITION " &
 158                                  "- 2: CHAR IS " & CH);
 159                     END IF;
 160                END IF;
 161
 162                SKIP_LINE (FT);
 163
 164                BEGIN
 165                     GET (FT, X);
 166                     FAILED ("DATA_ERROR NOT RAISED - 3");
 167                EXCEPTION
 168                     WHEN DATA_ERROR =>
 169                          IF X /= GREYISH THEN
 170                               FAILED ("ACTUAL PARAMETER TO GET " &
 171                                       "AFFECTED ON DATA_ERROR - 3");
 172                          END IF;
 173                     WHEN OTHERS =>
 174                          FAILED ("WRONG EXCEPTION RAISED - 3");
 175                END;
 176
 177                IF END_OF_LINE (FT) THEN
 178                     FAILED ("GET STOPPED AT END OF LINE - 3");
 179                ELSE
 180                     GET (FT, CH);
 181                     IF CH /= '2' THEN
 182                          FAILED ("GET STOPPED AT WRONG POSITION " &
 183                                  "- 3: CHAR IS " & CH);
 184                     END IF;
 185                END IF;
 186
 187                SKIP_LINE (FT);
 188
 189                BEGIN
 190                     GET (FT, X);
 191                     FAILED ("DATA_ERROR NOT RAISED - 4");
 192                EXCEPTION
 193                     WHEN DATA_ERROR =>
 194                          IF X /= GREYISH THEN
 195                               FAILED ("ACTUAL PARAMETER TO GET " &
 196                                       "AFFECTED ON DATA_ERROR - 4");
 197                          END IF;
 198                     WHEN OTHERS =>
 199                          FAILED ("WRONG EXCEPTION RAISED - 4");
 200                END;
 201
 202                IF END_OF_LINE (FT) THEN
 203                     FAILED ("GET STOPPED AT END OF LINE - 4");
 204                ELSE
 205                     GET (FT, CH);
 206                     IF CH /= '$' THEN
 207                          FAILED ("GET STOPPED AT WRONG POSITION " &
 208                                  "- 4: CHAR IS " & CH);
 209                     END IF;
 210                END IF;
 211
 212                SKIP_LINE (FT);
 213
 214                BEGIN
 215                     GET (FT, X);
 216                     FAILED ("DATA_ERROR NOT RAISED - 5");
 217                EXCEPTION
 218                     WHEN DATA_ERROR =>
 219                          IF X /= GREYISH THEN
 220                               FAILED ("ACTUAL PARAMETER TO GET " &
 221                                       "AFFECTED ON DATA_ERROR - 5");
 222                          END IF;
 223                     WHEN OTHERS =>
 224                          FAILED ("WRONG EXCEPTION RAISED - 5");
 225                END;
 226
 227                IF END_OF_LINE (FT) THEN
 228                     FAILED ("GET STOPPED AT END OF LINE - 5");
 229                ELSE
 230                     GET (FT, CH);
 231                     IF CH /= '_' THEN
 232                          FAILED ("GET STOPPED AT WRONG POSITION " &
 233                                  "- 5: CHAR IS " & CH);
 234                     ELSE
 235                          GET (FT, CH);
 236                          IF CH /= 'I' THEN
 237                               FAILED ("ERROR READING DATA - 5");
 238                          END IF;
 239                     END IF;
 240                END IF;
 241
 242                SKIP_LINE (FT);
 243
 244                BEGIN
 245                     GET (FT, X);
 246                     FAILED ("DATA_ERROR NOT RAISED - 6");
 247                EXCEPTION
 248                     WHEN DATA_ERROR =>
 249                          IF X /= GREYISH THEN
 250                               FAILED ("ACTUAL PARAMETER TO GET " &
 251                                       "AFFECTED ON DATA_ERROR - 6");
 252                          END IF;
 253                     WHEN OTHERS =>
 254                          FAILED ("WRONG EXCEPTION RAISED - 6");
 255                END;
 256
 257                IF END_OF_LINE (FT) THEN
 258                     FAILED ("GET STOPPED AT END OF LINE - 6");
 259                ELSE
 260                     GET (FT, CH);
 261                     IF CH /= '_' THEN
 262                          FAILED ("GET STOPPED AT WRONG POSITION " &
 263                                  "- 6: CHAR IS " & CH);
 264                     END IF;
 265                END IF;
 266
 267                SKIP_LINE (FT);
 268
 269                BEGIN
 270                     GET (FT, X);
 271                     FAILED ("DATA_ERROR NOT RAISED - 7");
 272                EXCEPTION
 273                     WHEN DATA_ERROR =>
 274                          IF X /= GREYISH THEN
 275                               FAILED ("ACTUAL PARAMETER TO GET " &
 276                                       "AFFECTED ON DATA_ERROR - 7");
 277                          END IF;
 278                     WHEN OTHERS =>
 279                          FAILED ("WRONG EXCEPTION RAISED - 7");
 280                END;
 281
 282                IF NOT END_OF_LINE (FT) THEN
 283                     BEGIN
 284                          GET (FT, X);
 285                          FAILED ("GET STOPPED AT WRONG  POSITION " &
 286                                  "- 7");
 287                     EXCEPTION
 288                          WHEN END_ERROR =>
 289                               NULL;
 290                          WHEN OTHERS =>
 291                               FAILED ("WRONG EXCEPTION RAISED FOR " &
 292                                       "EMPTY FILE - 7");
 293                     END;
 294                END IF;
 295           END;
 296
 297           BEGIN
 298                DELETE (FT);
 299           EXCEPTION
 300                WHEN USE_ERROR =>
 301                     NULL;
 302           END;
 303
 304      EXCEPTION
 305           WHEN INCOMPLETE =>
 306                NULL;
 307      END;
 308
 309      RESULT;
 310
 311 END CE3905L;