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

   1 -- CE3407A.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 END_OF_PAGE RETURNS THE CORRECT VALUE WHEN POSITIONED
  27 --     AT THE BEGINNING AND AT THE END OF THE PAGE, AND BEFORE A FILE
  28 --     TERMINATOR.
  29
  30 -- APPLICABILITY CRITERIA:
  31 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  32 --     TEXT FILES.
  33
  34 -- HISTORY:
  35 --     ABW 08/26/82
  36 --     SPS 09/22/82
  37 --     JBG 01/26/83
  38 --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
  39 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  40 --     JLH 08/28/87  REMOVED UNNECESSARY CODE, REMOVED DEPENDENCE
  41 --                   ON RESET AND CHECKED FOR USE_ERROR ON DELETE.
  42
  43 WITH REPORT;
  44 USE REPORT;
  45 WITH TEXT_IO;
  46 USE TEXT_IO;
  47
  48 PROCEDURE CE3407A IS
  49
  50      INCOMPLETE : EXCEPTION;
  51      FILE1 : FILE_TYPE;
  52      CHAR  : CHARACTER := ('C');
  53      ITEM_CHAR : CHARACTER;
  54
  55 BEGIN
  56
  57      TEST ("CE3407A", "CHECK THAT END_OF_PAGE RETURNS " &
  58                       "THE CORRECT VALUE");
  59
  60 -- CREATE & INITIALIZE OUTPUT FILE
  61
  62      BEGIN
  63           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
  64      EXCEPTION
  65           WHEN USE_ERROR =>
  66                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE WITH " &
  67                                "OUT_FILE MODE");
  68                RAISE INCOMPLETE;
  69           WHEN NAME_ERROR =>
  70                NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT CREATE " &
  71                                "WITH OUT_FILE MODE");
  72                RAISE INCOMPLETE;
  73           WHEN OTHERS =>
  74                FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT CREATE");
  75                RAISE INCOMPLETE;
  76      END;
  77
  78      FOR I IN 1..6 LOOP
  79           PUT (FILE1, CHAR);
  80      END LOOP;
  81
  82      CLOSE (FILE1);
  83
  84      BEGIN
  85           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
  86      EXCEPTION
  87           WHEN USE_ERROR =>
  88                NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT OPEN WITH " &
  89                                "IN_FILE MODE");
  90                RAISE INCOMPLETE;
  91      END;
  92
  93      IF END_OF_PAGE (FILE1) THEN
  94           FAILED ("INCORRECT VALUE AT FIRST POSITION - 1");
  95      END IF;
  96
  97      IF END_OF_PAGE (FILE1) THEN
  98           FAILED ("INCORRECT VALUE AT FIRST POSITION - 2");
  99      END IF;
 100
 101 -- TEST WHEN POSITIONED BEFORE LAST CHARACTER IN FILE
 102
 103      FOR I IN 1..5 LOOP
 104           GET (FILE1, ITEM_CHAR);
 105      END LOOP;
 106
 107      IF END_OF_PAGE (FILE1) THEN
 108           FAILED ("INCORRECT VALUE BEFORE LAST CHARACTER");
 109      END IF;
 110
 111 -- TEST WHEN AT END OF FILE
 112
 113      GET (FILE1, ITEM_CHAR);
 114      IF NOT END_OF_PAGE (FILE1) THEN
 115           FAILED ("INCORRECT VALUE AT LAST POSITION");
 116      END IF;
 117
 118      SKIP_PAGE (FILE1);
 119
 120      IF NOT END_OF_PAGE (FILE1) THEN
 121           FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 1");
 122      END IF;
 123
 124      IF NOT END_OF_PAGE (FILE1) THEN
 125           FAILED ("INCORRECT VALUE BEFORE FILE TERMINATOR - 2");
 126      END IF;
 127
 128      BEGIN
 129           DELETE (FILE1);
 130      EXCEPTION
 131           WHEN USE_ERROR =>
 132                NULL;
 133      END;
 134
 135      RESULT;
 136
 137 EXCEPTION
 138      WHEN INCOMPLETE =>
 139           RESULT;
 140
 141 END CE3407A;