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

   1 -- CE2103D.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 IS_OPEN RETURNS THE PROPER VALUES FOR FILES OF
  27 --     TYPE DIRECT_IO.
  28
  29 --          B) OPENED FILES
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTAIONS WHICH SUPPORT
  33 --     CREATION OF EXTERNAL FILES FOR DIRECT FILES.
  34
  35 -- HISTORY:
  36 --     SPW 08/13/87  CREATED ORIGINAL TEST.
  37
  38 WITH REPORT; USE REPORT;
  39 WITH DIRECT_IO;
  40
  41 PROCEDURE CE2103D IS
  42
  43      PACKAGE DIR_IO IS NEW DIRECT_IO(CHARACTER);
  44      USE DIR_IO;
  45      INCOMPLETE : EXCEPTION;
  46      TEST_FILE_ONE : DIR_IO.FILE_TYPE;
  47      VAL : BOOLEAN;
  48
  49 BEGIN
  50
  51      TEST ("CE2103D", "CHECK THAT IS_OPEN RETURNS THE PROPER " &
  52                       "VALUES FOR FILES OF TYPE DIRECT_IO");
  53
  54 -- FOLLOWING A CREATE
  55
  56      VAL := FALSE;
  57
  58      BEGIN
  59           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
  60      EXCEPTION
  61           WHEN USE_ERROR =>
  62                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
  63                                "OUT_FILE MODE");
  64                RAISE INCOMPLETE;
  65           WHEN NAME_ERROR =>
  66                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
  67                                "OUT_FILE MODE");
  68                RAISE INCOMPLETE;
  69      END;
  70
  71      VAL := IS_OPEN (TEST_FILE_ONE);
  72      IF VAL = FALSE THEN
  73           FAILED ("IS_OPEN RETURNS FALSE AFTER CREATE");
  74      END IF;
  75
  76 -- FOLLOWING CLOSE
  77
  78      VAL := TRUE;
  79      CLOSE (TEST_FILE_ONE);
  80      VAL := IS_OPEN (TEST_FILE_ONE);
  81      IF VAL = TRUE THEN
  82           FAILED ("IS_OPEN RETURNS TRUE AFTER CLOSE");
  83      END IF;
  84
  85 -- FOLLOWING OPEN
  86
  87      VAL := FALSE;
  88
  89      BEGIN
  90           OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
  91      EXCEPTION
  92           WHEN USE_ERROR =>
  93                IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
  94                     FAILED ("IS_OPEN GIVES TRUE ON " &
  95                             "UNSUCCESSFUL OPEN");
  96                END IF;
  97                RAISE INCOMPLETE;
  98      END;
  99
 100      VAL := IS_OPEN (TEST_FILE_ONE);
 101      IF VAL = FALSE THEN
 102           FAILED ("IS_OPEN RETURNS FALSE AFTER OPEN");
 103      END IF;
 104
 105 -- AFTER RESET
 106
 107      VAL := FALSE;
 108
 109      BEGIN
 110           RESET (TEST_FILE_ONE);
 111      EXCEPTION
 112           WHEN USE_ERROR =>
 113                NULL;
 114      END;
 115
 116      VAL := IS_OPEN (TEST_FILE_ONE);
 117      IF VAL = FALSE THEN
 118           FAILED ("IS_OPEN RETURNS FALSE AFTER RESET");
 119      END IF;
 120
 121 -- AFTER DELETE
 122
 123      VAL := TRUE;
 124
 125      BEGIN
 126           DELETE (TEST_FILE_ONE);
 127      EXCEPTION
 128           WHEN USE_ERROR =>
 129                IF IS_OPEN (TEST_FILE_ONE) /= FALSE THEN
 130                     FAILED ("IS_OPEN GIVES TRUE ON UNSUCCESSFUL " &
 131                             "DELETE");
 132                END IF;
 133                RAISE INCOMPLETE;
 134      END;
 135
 136      VAL := IS_OPEN (TEST_FILE_ONE);
 137      IF VAL = TRUE THEN
 138           FAILED ("IS_OPEN RETURNS TRUE AFTER DELETE");
 139      END IF;
 140
 141      RESULT;
 142
 143 EXCEPTION
 144
 145      WHEN INCOMPLETE =>
 146           RESULT;
 147
 148 END CE2103D;