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

   1 -- CE3403B.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 THE SPACING PARAMETER OF SKIP_LINE IS OPTIONAL,
  27 --     AND THAT THE DEFAULT VALUE IS ONE.
  28 --     CHECK THAT THE FILE PARAMETER IS ALSO OPTIONAL, AND THAT THE
  29 --     FUNCTION IS THEN APPLIED TO THE CURRENT DEFAULT INPUT FILE.
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
  33 --     SUPPORT TEXT FILES.
  34
  35 -- HISTORY:
  36 --     ABW 08/26/82
  37 --     SPS 12/14/82
  38 --     JBG 1/17/83
  39 --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  40 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  41 --     DWC 09/04/87  REVISED EXCEPTION HANDLERS, REMOVED
  42 --                   DEPENDENCIES ON RESET, AND ADDED AN ATTEMPT
  43 --                   TO DELETE FILE.
  44
  45 WITH REPORT;
  46 USE REPORT;
  47 WITH TEXT_IO;
  48 USE TEXT_IO;
  49
  50 PROCEDURE CE3403B IS
  51
  52      INCOMPLETE : EXCEPTION;
  53      FILE : FILE_TYPE;
  54      SPAC, TWO : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
  55      A    : INTEGER := CHARACTER'POS('A');
  56      CH   : CHARACTER;
  57
  58 BEGIN
  59
  60      TEST ("CE3403B" , "CHECK DEFAULT SPACING AND FILE " &
  61                        "OF SKIP_LINE");
  62
  63      BEGIN
  64           CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
  65      EXCEPTION
  66           WHEN USE_ERROR =>
  67                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
  68                                "WITH OUT_FILE MODE");
  69                RAISE INCOMPLETE;
  70           WHEN NAME_ERROR =>
  71                NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
  72                                "WITH OUT_FILE MODE");
  73                RAISE INCOMPLETE;
  74           WHEN OTHERS =>
  75                FAILED ("UNEXPECTED EXCEPTION RAISED; TEXT CREATE");
  76                RAISE INCOMPLETE;
  77      END;
  78
  79      FOR I IN 1 .. 3 LOOP          -- CREATES "BBB#CC#D##F#@%"
  80           FOR J IN 1 .. 4-I LOOP
  81                PUT (FILE, CHARACTER'VAL(A + I));
  82           END LOOP;
  83           NEW_LINE (FILE);
  84      END LOOP;
  85      NEW_LINE (FILE);
  86      PUT (FILE, 'F');
  87
  88      CLOSE (FILE);
  89
  90      BEGIN
  91           OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
  92      EXCEPTION
  93           WHEN USE_ERROR =>
  94                NOT_APPLICABLE ("USE_ERROR RAISED; TEXT OPEN " &
  95                                "FOR IN_FILE MODE");
  96                RAISE INCOMPLETE;
  97      END;
  98
  99      GET (FILE, CH);
 100      IF CH /= CHARACTER'VAL (A + 1) THEN
 101           FAILED ("LINE CONTENT WRONG - 1");
 102      END IF;
 103
 104      SKIP_LINE (FILE);
 105
 106      IF LINE (FILE) /= TWO THEN
 107           FAILED ("SPACING DEFAULT NOT ONE");
 108      END IF;
 109
 110      GET (FILE, CH);
 111      IF CH /= CHARACTER'VAL (A + 2) THEN
 112           FAILED ("LINE CONTENT WRONG - 2");
 113      END IF;
 114
 115      SET_INPUT (FILE);
 116      SKIP_LINE (FILE);
 117
 118      IF LINE (FILE) /= 3 THEN
 119           FAILED ("SKIP_LINE DOES NOT OPERATE CORRECTLY ON " &
 120                   "DEFAULT FILE");
 121      END IF;
 122
 123      GET (FILE, CH);
 124      IF CH /= CHARACTER'VAL (A + 3) THEN
 125           FAILED ("LINE CONTENT WRONG - 3");
 126      END IF;
 127
 128      SKIP_LINE;
 129
 130      IF LINE (FILE) /= 4 THEN
 131           FAILED ("LINE COUNT NOT 4; WAS " & COUNT'IMAGE(LINE(FILE)));
 132      END IF;
 133
 134      GET (FILE, CH);
 135      IF CH /= 'F' THEN
 136           FAILED ("NOT RIGHT LINE");
 137      END IF;
 138
 139      BEGIN
 140           DELETE (FILE);
 141      EXCEPTION
 142           WHEN USE_ERROR =>
 143                NULL;
 144      END;
 145
 146      RESULT;
 147
 148 EXCEPTION
 149      WHEN INCOMPLETE =>
 150           RESULT;
 151
 152 END CE3403B;