gomp-20050608-branch/gcc/testsuite/ada/acats/tests/ce/ce2104c.ada

   1 -- CE2104C.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 A FILE CAN BE CLOSED AND THEN RE-OPENED.
  27
  28 --          B) DIRECT FILES
  29
  30 -- APPLICABLILITY CRITERIA:
  31 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHOSE
  32 --     ENVIRONMENT SUPPORTS CREATE/OPEN FOR THE GIVEN MODE.
  33
  34 -- HISTORY:
  35 --     DLD 08/11/82
  36 --     SPS 11/09/82
  37 --     JBG 03/24/83
  38 --     EG  06/03/85
  39 --     PWB 02/10/86  CORRECTED REPORTED TEST NAME; CHANGED DATA FILE
  40 --                   NAME TO "Y2104C" TO MATCH TEST NAME.
  41 --     SPW 08/07/87  REMOVED UNNECESSARY CODE AND CORRECTED EXCEPTION
  42 --                   HANDLING.
  43
  44 WITH REPORT; USE REPORT;
  45 WITH DIRECT_IO;
  46
  47 PROCEDURE CE2104C IS
  48
  49      PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
  50      USE DIR_IO;
  51
  52      DIR_FILE : DIR_IO.FILE_TYPE;
  53      VAR : INTEGER;
  54      INCOMPLETE : EXCEPTION;
  55
  56 BEGIN
  57
  58      TEST ("CE2104C", "CHECK THAT A FILE CAN BE CLOSED " &
  59                       "AND THEN RE-OPENED");
  60
  61 -- INITIALIZE TEST FILE
  62
  63      BEGIN
  64           CREATE (DIR_FILE, OUT_FILE, LEGAL_FILE_NAME);
  65      EXCEPTION
  66           WHEN USE_ERROR =>
  67                NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE WITH " &
  68                                "OUT_FILE MODE");
  69                RAISE INCOMPLETE;
  70           WHEN NAME_ERROR =>
  71                NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE WITH " &
  72                                "OUT_FILE MODE");
  73                RAISE INCOMPLETE;
  74           WHEN OTHERS =>
  75                FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
  76                RAISE INCOMPLETE;
  77
  78      END;
  79
  80      WRITE (DIR_FILE, 28);
  81      CLOSE (DIR_FILE);
  82
  83 -- RE-OPEN DIRECT TEST FILE
  84
  85      BEGIN
  86           OPEN (DIR_FILE, IN_FILE, LEGAL_FILE_NAME);
  87      EXCEPTION
  88           WHEN USE_ERROR =>
  89                NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN WITH " &
  90                                "IN_FILE MODE");
  91                RAISE INCOMPLETE;
  92      END;
  93
  94      READ (DIR_FILE, VAR);
  95      IF VAR /= 28 THEN
  96           FAILED ("WRONG DATA RETURNED FROM READ - DIRECT");
  97      END IF;
  98
  99 -- DELETE TEST FILE
 100
 101      BEGIN
 102           DELETE (DIR_FILE);
 103      EXCEPTION
 104           WHEN USE_ERROR =>
 105                NULL;
 106      END;
 107
 108      RESULT;
 109
 110 EXCEPTION
 111
 112      WHEN INCOMPLETE =>
 113           RESULT;
 114
 115 END CE2104C;