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

   1 -- CE3108A.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 -- APPLICABILITY CRITERIA:
  29 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  30 --     TEXT FILES.
  31
  32 -- HISTORY:
  33 --     DLD 08/11/82
  34 --     SPS 11/09/82
  35 --     JBG 03/24/83
  36 --     EG  05/16/85
  37 --     GMT 08/17/87  REMOVED UNNECESSARY CODE AND ADDED A CHECK FOR
  38 --                   USE_ERROR ON DELETE.
  39
  40 WITH REPORT; USE REPORT;
  41 WITH TEXT_IO; USE TEXT_IO;
  42
  43 PROCEDURE CE3108A IS
  44
  45      TXT_FILE   : FILE_TYPE;
  46      VAR        : STRING (1..2);
  47      LAST       : INTEGER;
  48      INCOMPLETE : EXCEPTION;
  49
  50 BEGIN
  51
  52      TEST ("CE3108A", "CHECK THAT A FILE CAN BE CLOSED " &
  53                       "AND THEN RE-OPENED");
  54
  55      -- INITIALIZE TEST FILES
  56
  57      BEGIN
  58
  59           BEGIN
  60                CREATE (TXT_FILE, OUT_FILE, LEGAL_FILE_NAME);
  61           EXCEPTION
  62                WHEN NAME_ERROR =>
  63                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE");
  64                     RAISE INCOMPLETE;
  65                WHEN USE_ERROR =>
  66                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE");
  67                     RAISE INCOMPLETE;
  68           END;
  69
  70           BEGIN
  71                PUT (TXT_FILE, "17");
  72                CLOSE (TXT_FILE);
  73
  74                -- RE-OPEN TEXT TEST FILE
  75
  76                BEGIN
  77                     OPEN (TXT_FILE, IN_FILE, LEGAL_FILE_NAME);
  78                EXCEPTION
  79                     WHEN USE_ERROR =>
  80                          NOT_APPLICABLE ("USE_ERROR RAISED ON OPEN");
  81                          RAISE INCOMPLETE;
  82                END;
  83
  84                GET (TXT_FILE, VAR);
  85                IF VAR /= "17" THEN
  86                     FAILED ("WRONG DATA RETURNED FROM READ -TEXT");
  87                END IF;
  88
  89                -- DELETE TEST FILES
  90
  91                BEGIN
  92                     DELETE (TXT_FILE);
  93                EXCEPTION
  94                     WHEN USE_ERROR =>
  95                          NULL;
  96                END;
  97           END;
  98
  99      EXCEPTION
 100           WHEN INCOMPLETE =>
 101                NULL;
 102      END;
 103
 104      RESULT;
 105
 106 END CE3108A;