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

   1 -- CE3405A.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_PAGE OUTPUTS A LINE TERMINATOR FOLLOWED BY A PAGE
  27 --     TERMINATOR IF THE CURRENT LINE IS NOT AT COLUMN 1 OR IF THE
  28 --     CURRENT PAGE IS AT LINE 1;  IF THE CURRENT LINE IS AT COLUMN 1,
  29 --     OUTPUTS A PAGE TERMINATOR ONLY.
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
  33 --     SUPPORT TEXT FILES.
  34
  35 -- HISTORY:
  36 --     ABW 09/02/82
  37 --     JBG 01/18/83
  38 --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  39 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  40 --     DWC 09/23/87  ADDED A CASE WHICH CALLS NEW_LINE AND NEW_PAGE
  41 --                   CONSECUTIVELY AND SEPARATED CASES INTO DIFFERENT
  42 --                   IF STATEMENTS.  ADDED CHECK FOR USE_ERROR ON
  43 --                   DELETE.
  44
  45 WITH REPORT;
  46 USE REPORT;
  47 WITH TEXT_IO;
  48 USE TEXT_IO;
  49 WITH CHECK_FILE;
  50
  51 PROCEDURE CE3405A IS
  52
  53      INCOMPLETE : EXCEPTION;
  54      FILE  : FILE_TYPE;
  55      ONE   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(1));
  56      TWO   : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(2));
  57      THREE : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(3));
  58      FOUR  : POSITIVE_COUNT := POSITIVE_COUNT(IDENT_INT(4));
  59      CHAR  : CHARACTER := ('C');
  60
  61 BEGIN
  62
  63      TEST ("CE3405A", "CHECK THAT NEW_PAGE OUTPUTS A LINE TERMINATOR " &
  64                       "FOLLOWED BY A PAGE TERMINATOR IF THE CURRENT " &
  65                       "LINE IS NOT AT COLUMN 1 OR IF THE CURRENT " &
  66                       "PAGE IS AT LINE 1;  IF THE CURRENT LINE IS AT " &
  67                       "COLUMN 1, OUTPUTS A PAGE TERMINATOR ONLY");
  68
  69      BEGIN
  70           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
  71      EXCEPTION
  72           WHEN USE_ERROR =>
  73                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
  74                                "WITH OUT_FILE MODE");
  75                RAISE INCOMPLETE;
  76           WHEN NAME_ERROR =>
  77                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
  78                                "WITH OUT_FILE MODE");
  79                RAISE INCOMPLETE;
  80      END;
  81
  82      NEW_PAGE (FILE);
  83      NEW_PAGE (FILE);                   -- CURRENT PAGE TERMINATED
  84      IF PAGE (FILE) /= THREE THEN
  85           FAILED ("INITIAL PAGE COUNT INCORRECT");
  86      END IF;
  87
  88      SET_LINE_LENGTH (FILE,THREE);
  89      PUT (FILE,CHAR);
  90      NEW_LINE (FILE);
  91
  92      IF LINE (FILE) /= TWO THEN
  93           FAILED ("INCORRECT LINE NUMBER - 1");
  94      END IF;
  95
  96      IF PAGE (FILE) /= THREE THEN
  97           FAILED ("INCORRECT PAGE NUMBER - 2");
  98      END IF;
  99
 100      NEW_PAGE (FILE);             -- CURRENT LINE TERMINATED (B)
 101      IF LINE (FILE) /= ONE THEN
 102           FAILED ("LINE NUMBER NOT INCREMENTED");
 103      END IF;
 104      IF PAGE (FILE) /= FOUR THEN
 105           FAILED ("PAGE NUMBER NOT INCREMENTED");
 106      END IF;
 107      PUT (FILE, IDENT_CHAR('E'));  -- CURRENT LINE NOT TERM (C)
 108      NEW_PAGE (FILE);
 109      NEW_LINE (FILE);
 110      NEW_PAGE (FILE);
 111
 112      CHECK_FILE (FILE, "#@#@C#@E#@#@%");
 113
 114      BEGIN
 115           DELETE (FILE);
 116      EXCEPTION
 117           WHEN USE_ERROR =>
 118                NULL;
 119      END;
 120
 121      RESULT;
 122
 123 EXCEPTION
 124      WHEN INCOMPLETE =>
 125           RESULT;
 126
 127 END CE3405A;