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

   1 -- CE2409B.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 --     FOR DIRECT ACCESS FILES, CHECK THAT A WRITE TO A POSITION
  27 --     GREATER THAN THE CURRENT END POSITION CAUSES THE WRITE
  28 --     POSITION AND THE FILE SIZE TO BE INCREMENTED.
  29
  30 --          2) CHECK FILES OF MODE OUT_FILE.
  31
  32 -- APPLICABILITY CRITERIA:
  33 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  34 --     CREATE WITH MODE OUT_FILE FOR DIRECT FILES.
  35
  36 -- HISTORY:
  37 --     GMT 08/05/87  CREATED ORIGINAL TEST.
  38
  39 WITH REPORT; USE REPORT;
  40 WITH DIRECT_IO;
  41
  42 PROCEDURE CE2409B IS
  43
  44      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
  45      USE DIR;
  46      FILE1      : FILE_TYPE;
  47      INCOMPLETE : EXCEPTION;
  48
  49 BEGIN
  50
  51      TEST ("CE2409B", "CHECK THAT WRITE POSITION AND " &
  52                       "SIZE ARE INCREMENTED APPROPRIATELY");
  53      BEGIN
  54           CREATE (FILE1, OUT_FILE);
  55      EXCEPTION
  56           WHEN USE_ERROR =>
  57                NOT_APPLICABLE ("CREATE WITH MODE OUT_FILE NOT " &
  58                                "SUPPORTED FOR DIR FILES - 1");
  59                RAISE INCOMPLETE;
  60      END;
  61
  62      DECLARE
  63           INT      : INTEGER := IDENT_INT (18);
  64           TWO_C    : COUNT := COUNT (IDENT_INT(2));
  65           THREE_C  : COUNT := COUNT (IDENT_INT(3));
  66           THREE_PC : POSITIVE_COUNT
  67                            := POSITIVE_COUNT (IDENT_INT(3));
  68           FOUR_PC  : POSITIVE_COUNT
  69                            := POSITIVE_COUNT (IDENT_INT(4));
  70      BEGIN
  71           WRITE (FILE1, INT);
  72           WRITE (FILE1, INT);
  73           IF INDEX (FILE1) /= THREE_PC THEN
  74                FAILED ("INCORRECT VALUE FOR INDEX - 2");
  75           END IF;
  76           IF SIZE (FILE1) /= TWO_C THEN
  77                FAILED ("INCORRECT VALUE FOR SIZE - 3");
  78           END IF;
  79
  80           WRITE (FILE1, INT);
  81           IF INDEX (FILE1) /= FOUR_PC THEN
  82                FAILED ("INCORRECT VALUE FOR INDEX - 4");
  83           END IF;
  84           IF SIZE (FILE1) /= THREE_C THEN
  85                FAILED ("INCORRECT VALUE FOR SIZE - 5");
  86           END IF;
  87
  88      END;
  89
  90      CLOSE (FILE1);
  91
  92      RESULT ;
  93
  94 EXCEPTION
  95      WHEN INCOMPLETE =>
  96           RESULT;
  97
  98 END CE2409B ;