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

   1 -- CE2208B.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 CAN BE OVERWRITTEN IN THE SEQUENTIAL FILE AND THE
  27 --     CORRECT VALUES CAN LATER BE READ.  ALSO CHECK THAT OVERWRITING
  28 --     TRUNCATES THE FILE TO THE LAST ELEMENT WRITTEN.
  29
  30 -- APPLICABILITY CRITERIA:
  31 --      THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  32 --      THE CREATING AND OPENING OF SEQUENTIAL FILES.
  33
  34 -- HISTORY:
  35 --     TBN  09/30/86  CREATED ORIGINAL TEST.
  36 --     GMT  07/24/87  ADDED CHECKS FOR USE_ERROR AND REMOVED SOME CODE.
  37 --     BCB  10/03/90  CHANGED CODE TO CHECK THAT OVERWRITING TRUNCATES
  38 --                    INSTEAD OF WHETHER IT TRUNCATES.
  39
  40 WITH SEQUENTIAL_IO;
  41 WITH REPORT; USE REPORT;
  42 PROCEDURE CE2208B IS
  43
  44      PACKAGE SEQ_IO IS NEW SEQUENTIAL_IO (INTEGER);
  45      USE SEQ_IO;
  46
  47      FILE1      : FILE_TYPE;
  48      INCOMPLETE : EXCEPTION;
  49
  50 BEGIN
  51      TEST ("CE2208B",
  52            "CHECK THAT DATA CAN BE OVERWRITTEN IN THE SEQUENTIAL " &
  53            "FILE AND THE CORRECT VALUES CAN LATER BE READ.  ALSO " &
  54            "CHECK THAT OVERWRITING TRUNCATES THE FILE." );
  55
  56      -- INITIALIZE TEST FILE
  57
  58      BEGIN
  59           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
  60      EXCEPTION
  61           WHEN NAME_ERROR =>
  62                NOT_APPLICABLE ("NAME_ERROR RAISED DURING CREATE");
  63                RAISE INCOMPLETE;
  64           WHEN USE_ERROR =>
  65                NOT_APPLICABLE ("USE_ERROR RAISED DURING CREATE");
  66                RAISE INCOMPLETE;
  67           WHEN OTHERS =>
  68                FAILED ("UNKNOWN EXCEPTION RAISED DURING CREATE");
  69                RAISE INCOMPLETE;
  70      END;
  71
  72      BEGIN
  73           FOR I IN 1 .. 25 LOOP
  74                WRITE (FILE1, I);
  75           END LOOP;
  76      EXCEPTION
  77           WHEN OTHERS =>
  78                FAILED ("UNEXPECTED EXCEPTION RAISED DURING WRITE");
  79                RAISE INCOMPLETE;
  80      END;
  81
  82      BEGIN
  83           CLOSE (FILE1);
  84      EXCEPTION
  85           WHEN OTHERS =>
  86                FAILED ("UNEXPECTED EXCEPTION RAISED DURING CLOSE");
  87                RAISE INCOMPLETE;
  88      END;
  89
  90      BEGIN
  91           OPEN (FILE1, OUT_FILE, LEGAL_FILE_NAME);
  92      EXCEPTION
  93           WHEN USE_ERROR =>
  94                NOT_APPLICABLE ( "OPEN WITH  OUT_FILE  MODE NOT "  &
  95                                 "SUPPORTED FOR SEQUENTIAL FILES" );
  96                RAISE INCOMPLETE;
  97           WHEN OTHERS =>
  98                FAILED ("EXCEPTION RAISED DURING OPEN");
  99                RAISE INCOMPLETE;
 100      END;
 101
 102      BEGIN
 103           FOR I IN 26 .. 36 LOOP
 104                WRITE (FILE1, I);
 105           END LOOP;
 106      EXCEPTION
 107           WHEN OTHERS =>
 108                FAILED ("UNEXPECTED EXCEPTION RAISED DURING OVERWRITE");
 109                RAISE INCOMPLETE;
 110      END;
 111
 112      BEGIN
 113           CLOSE (FILE1);
 114      EXCEPTION
 115           WHEN OTHERS =>
 116                FAILED ("UNEXPECTED EXCEPTION RAISED DURING 2ND CLOSE");
 117                RAISE INCOMPLETE;
 118      END;
 119
 120      BEGIN
 121           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
 122      EXCEPTION
 123           WHEN USE_ERROR =>
 124                NOT_APPLICABLE ( "OPEN WITH  IN_FILE  MODE NOT "   &
 125                                 "SUPPORTED FOR SEQUENTIAL FILES" );
 126                RAISE INCOMPLETE;
 127           WHEN OTHERS =>
 128                FAILED ("EXCEPTION RAISED DURING SECOND OPEN");
 129                RAISE INCOMPLETE;
 130      END;
 131
 132      DECLARE
 133           END_REACHED : BOOLEAN := FALSE;
 134           COUNT : INTEGER := 26;
 135           NUM : INTEGER;
 136      BEGIN
 137           WHILE COUNT <= 36 AND NOT END_REACHED LOOP
 138                BEGIN
 139                     READ (FILE1, NUM);
 140                     IF NUM /= COUNT THEN
 141                          FAILED ("INCORRECT RESULTS READ FROM FILE " &
 142                                  INTEGER'IMAGE (NUM));
 143                     END IF;
 144                     COUNT := COUNT + 1;
 145                EXCEPTION
 146                     WHEN END_ERROR =>
 147                          END_REACHED := TRUE;
 148                     WHEN OTHERS =>
 149                          FAILED ("UNEXPECTED EXCEPTION RAISED DURING " &
 150                                  "READING - 1");
 151                          RAISE INCOMPLETE;
 152                END;
 153           END LOOP;
 154           IF COUNT <= 36 THEN
 155                FAILED ("FILE WAS INCOMPLETE");
 156                RAISE INCOMPLETE;
 157           ELSE
 158                BEGIN
 159                     READ (FILE1, NUM);
 160                     FAILED ("END_ERROR NOT RAISED BY ATTEMPT TO READ");
 161                EXCEPTION
 162                     WHEN END_ERROR =>
 163                          NULL;
 164                     WHEN OTHERS =>
 165                          FAILED ("UNEXPECTED EXCEPTION RAISED " &
 166                                  "DURING READING - 2");
 167                          RAISE INCOMPLETE;
 168                END;
 169           END IF;
 170      END;
 171
 172      BEGIN
 173           DELETE (FILE1);
 174      EXCEPTION
 175           WHEN USE_ERROR =>
 176                NULL;
 177      END;
 178
 179      RESULT;
 180
 181 EXCEPTION
 182      WHEN INCOMPLETE =>
 183           RESULT;
 184
 185 END CE2208B;