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

   1 -- CE3402C.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 NEW_LINE INCREMENTS THE CURRENT PAGE BY ONE AND
  27 --     SETS THE CURRENT LINE NUMBER TO ONE WHEN THE PAGE LENGTH IS
  28 --     BOUNDED AND THE LINE NUMBER WOULD HAVE EXCEEDED THE
  29 --     MAXIMUM PAGE LENGTH.
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  33 --     TEXT FILES.
  34
  35 -- HISTORY:
  36 --     ABW 09/01/82
  37 --     SPS 11/30/82
  38 --     SPS 01/24/82
  39 --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  40 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  41 --     DWC 08/19/87  ADDED ORIGINAL_LINE_LENGTH AND
  42 --                   ORIGINAL_PAGE_LENGTH VARIABLES AND CLOSED FILE.
  43
  44 WITH REPORT;
  45 USE REPORT;
  46 WITH TEXT_IO;
  47 USE TEXT_IO;
  48 WITH CHECK_FILE;
  49
  50 PROCEDURE CE3402C IS
  51
  52      INCOMPLETE : EXCEPTION;
  53      FILE : FILE_TYPE;
  54      ONE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
  55      TWO : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
  56      THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
  57      CHAR : CHARACTER := ('C');
  58      ITEM_CHAR : CHARACTER;
  59      ORIGINAL_LINE_LENGTH : COUNT := LINE_LENGTH;
  60      ORIGINAL_PAGE_LENGTH : COUNT := PAGE_LENGTH;
  61
  62 BEGIN
  63
  64      TEST ("CE3402C" , "CHECK END_OF_PAGE BEHAVIOR OF NEW_LINE");
  65
  66      BEGIN
  67           CREATE (FILE);
  68      EXCEPTION
  69           WHEN USE_ERROR =>
  70                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE");
  71                RAISE INCOMPLETE;
  72           WHEN OTHERS =>
  73                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
  74                RAISE INCOMPLETE;
  75      END;
  76
  77      SET_LINE_LENGTH (FILE,THREE);
  78      SET_PAGE_LENGTH (FILE,TWO);
  79
  80      FOR I IN 1..6
  81      LOOP
  82           PUT (FILE,CHAR);
  83      END LOOP;
  84
  85      NEW_LINE (FILE);
  86
  87      IF PAGE (FILE) /= TWO THEN
  88           FAILED ("PAGE NOT INCREMENTED BY ONE");
  89      END IF;
  90
  91      IF LINE (FILE) /= ONE THEN
  92           FAILED ("LINE NOT SET TO ONE");
  93      END IF;
  94
  95      NEW_LINE (FILE, 7);
  96      IF PAGE (FILE) /= POSITIVE_COUNT(IDENT_INT (5)) THEN
  97           FAILED ("MULTIPLE PAGES NOT CREATED BY NEW_LINE");
  98      END IF;
  99
 100      SET_LINE_LENGTH (FILE, ORIGINAL_LINE_LENGTH);
 101      SET_PAGE_LENGTH (FILE, ORIGINAL_PAGE_LENGTH);
 102      CHECK_FILE (FILE, "CCC#CCC#@##@##@##@#@%");
 103
 104      CLOSE (FILE);
 105
 106      RESULT;
 107
 108 EXCEPTION
 109      WHEN INCOMPLETE =>
 110           RESULT;
 111
 112 END CE3402C;