old-autovect-branch/gcc/testsuite/ada/acats/tests/ce/ce2205a.ada

   1 -- CE2205A.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 WHETHER  READ  FOR A SEQUENTIAL FILE RAISES  DATA_ERROR OR
  27 --     CONSTRAINT_ERROR WHEN AN ELEMENT IS READ THAT IS OUTSIDE THE
  28 --     RANGE OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE INSTANTIATED
  29 --     TYPE, AND CHECK THAT READING CAN CONTINUE AFTER THE EXCEPTION
  30 --     HAS BEEN HANDLED.
  31
  32 --          A) CHECK ENUMERATION TYPE.
  33
  34 -- APPLICABILITY CRITERIA:
  35 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
  36 --     SUPPORT SEQUENTIAL FILES.
  37
  38 -- HISTORY:
  39 --     SPS 09/28/82
  40 --     JBG 06/04/84
  41 --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  42 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  43 --     GMT 07/24/87  RENAMED FROM CE2210A.ADA AND REMOVED THE USE OF
  44 --                   RESET.
  45 --     PWB 05/18/89  DELETED CALL TO FAILED WHEN NO EXCEPTION RAISED.
  46
  47 WITH REPORT; USE REPORT;
  48 WITH SEQUENTIAL_IO;
  49
  50 PROCEDURE CE2205A IS
  51 BEGIN
  52
  53      TEST ("CE2205A", "CHECK WHETHER READ FOR A SEQUENTIAL FILE " &
  54                       "RAISES  DATA_ERROR OR CONSTRAINT_ERROR WHEN " &
  55                       "AN ELEMENT IS READ THAT IS OUTSIDE THE RANGE " &
  56                       "OF THE ITEM TYPE BUT WITHIN THE RANGE OF THE " &
  57                       "INSTANTIATED TYPE, AND CHECK THAT READING CAN " &
  58                       "CONTINUE AFTER THE EXCEPTION HAS BEEN HANDLED");
  59      DECLARE
  60           PACKAGE  SEQ  IS NEW  SEQUENTIAL_IO (CHARACTER);
  61           USE SEQ;
  62           FT : FILE_TYPE;
  63           SUBTYPE CH IS CHARACTER  RANGE 'A' .. 'D';
  64           X : CH;
  65           INCOMPLETE : EXCEPTION;
  66      BEGIN
  67           BEGIN
  68                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
  69           EXCEPTION
  70                WHEN USE_ERROR =>
  71                     NOT_APPLICABLE ("USE_ERROR RAISED ON SEQUENTIAL " &
  72                                     "CREATE WITH OUT_FILE MODE - 1");
  73                     RAISE INCOMPLETE;
  74                WHEN NAME_ERROR =>
  75                     NOT_APPLICABLE ("NAME_ERROR RAISED ON SEQUENTIAL " &
  76                                     "CREATE WITH OUT_FILE MODE - 2");
  77                     RAISE INCOMPLETE;
  78                WHEN OTHERS =>
  79                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
  80                             "SEQUENTIAL CREATE - 3");
  81                     RAISE INCOMPLETE;
  82           END;
  83
  84           WRITE (FT, 'A');
  85           WRITE (FT, 'M');
  86           WRITE (FT, 'B');
  87           WRITE (FT, 'C');
  88
  89           CLOSE (FT);
  90
  91           BEGIN
  92                OPEN  (FT, IN_FILE, LEGAL_FILE_NAME);
  93           EXCEPTION
  94                WHEN USE_ERROR =>
  95                     NOT_APPLICABLE ("OPEN WITH IN_FILE MODE IS NOT " &
  96                                     "SUPPORTED - 4");
  97                RAISE INCOMPLETE;
  98           END;
  99
 100           -- BEGIN TEST
 101
 102           READ (FT, X);
 103           IF X /= 'A' THEN
 104                FAILED ("INCORRECT VALUE FOR READ - 5");
 105           END IF;
 106
 107           BEGIN
 108                READ (FT, X);
 109                COMMENT ("NO EXCEPTION RAISED FOR READ WITH ELEMENT " &
 110                        "OUT OF RANGE");
 111           EXCEPTION
 112                WHEN CONSTRAINT_ERROR =>
 113                     COMMENT ("CONSTRAINT_ERROR RAISED FOR SCALAR "  &
 114                              "TYPES - 7");
 115                WHEN DATA_ERROR =>
 116                     COMMENT ("DATA_ERROR RAISED FOR SCALAR TYPES - 8");
 117                WHEN OTHERS =>
 118                     FAILED ("WRONG EXCEPTION RAISED - 9");
 119           END;
 120
 121           BEGIN
 122                READ (FT, X);
 123                IF X /= 'B' THEN
 124                     FAILED ("INCORRECT VALUE FOR READ - 10");
 125                END IF;
 126
 127                READ (FT, X);
 128                IF X /= 'C' THEN
 129                     FAILED ("INCORRECT VALUE FOR READ - 11");
 130                END IF;
 131           EXCEPTION
 132                WHEN OTHERS =>
 133                     FAILED ("UNABLE TO CONTINUE READING - 12");
 134                     RAISE INCOMPLETE;
 135           END;
 136
 137           BEGIN
 138                DELETE (FT);
 139           EXCEPTION
 140                WHEN USE_ERROR =>
 141                     NULL;
 142           END;
 143
 144      EXCEPTION
 145           WHEN INCOMPLETE =>
 146                NULL;
 147      END;
 148
 149      RESULT;
 150
 151 END CE2205A;