toolchain/gcc/gcc/testsuite/ada/acats/tests/ce/ce3410c.ada

   1 -- CE3410C.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 SET_LINE SETS THE CURRENT LINE NUMBER TO THE VALUE
  27 --     SPECIFIED BY TO FOR FILES OF MODES IN_FILE AND OUT_FILE.
  28 --     CHECK THAT IT HAS NO EFFECT IF THE VALUE SPECIFIED BY TO IS
  29 --     EQUAL TO THE CURRENT LINE NUMBER FOR BOTH IN_FILE AND OUT_FILE.
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  33 --     TEXT FILES.
  34
  35 -- HISTORY:
  36 --     ABW 08/26/82
  37 --     SPS 09/20/82
  38 --     JBG 01/27/83
  39 --     EG  05/22/85
  40 --     TBN 11/10/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
  41 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  42 --     JLH 09/01/87  REMOVED DEPENDENCE ON RESET, ADDED MORE TEST
  43 --                   CASES, AND CHECKED FOR USE_ERROR ON DELETE.
  44 --     JRL 02/29/96  Added File parameter to call to Set_Page_Length.
  45
  46 WITH REPORT; USE REPORT;
  47 WITH TEXT_IO; USE TEXT_IO;
  48 WITH CHECK_FILE;
  49
  50 PROCEDURE CE3410C IS
  51
  52      INCOMPLETE : EXCEPTION;
  53
  54 BEGIN
  55      TEST ("CE3410C", "CHECK THAT SET_LINE SETS LINE " &
  56                       "NUMBER CORRECTLY");
  57
  58      DECLARE
  59           FILE : FILE_TYPE;
  60           CHAR : CHARACTER := ('C');
  61           ITEM_CHAR : CHARACTER;
  62           ONE   : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
  63           TWO   : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(2));
  64           THREE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(3));
  65           FOUR  : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(4));
  66      BEGIN
  67
  68           BEGIN
  69                CREATE (FILE, OUT_FILE, LEGAL_FILE_NAME);
  70           EXCEPTION
  71                WHEN USE_ERROR =>
  72                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
  73                                     "WITH OUT_FILE MODE");
  74                     RAISE INCOMPLETE;
  75                WHEN NAME_ERROR =>
  76                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
  77                                     "CREATE WITH OUT_FILE MODE");
  78                     RAISE INCOMPLETE;
  79                WHEN OTHERS =>
  80                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
  81                             "CREATE");
  82                     RAISE INCOMPLETE;
  83           END;
  84
  85           SET_LINE (FILE, FOUR);
  86           IF LINE (FILE) /= FOUR THEN
  87                FAILED ("FOR OUT_FILE LINE NOT FOUR");
  88           ELSE
  89                PUT (FILE, 'C');
  90                NEW_LINE (FILE);
  91                SET_LINE (FILE, 5);
  92                IF LINE (FILE) /= FOUR+1 THEN
  93                     FAILED ("FOR OUT_FILE LINE UNNECESSARILY " &
  94                             "CHANGED FROM FOUR");
  95                ELSE
  96                     SET_LINE (FILE, 8);
  97                     PUT (FILE, "DE");
  98                     SET_LINE (FILE, TWO+1);
  99                     IF LINE (FILE) /= TWO+ONE THEN
 100                          FAILED ("FOR OUT_FILE LINE NOT THREE");
 101                     END IF;
 102
 103                     SET_LINE (FILE, TWO);
 104
 105                     IF PAGE (FILE) /= ONE+TWO THEN
 106                          FAILED ("PAGE TERMINATOR NOT OUTPUT - 2");
 107                     END IF;
 108
 109                     IF LINE (FILE) /= TWO THEN
 110                          FAILED ("LINE NOT TWO; IS" &
 111                                  COUNT'IMAGE(LINE(FILE)));
 112                     END IF;
 113
 114                     SET_PAGE_LENGTH (FILE, TWO);
 115                     PUT (FILE, 'X');
 116                     SET_LINE (FILE, TWO);
 117                     PUT (FILE, 'Y');
 118
 119                     IF LINE (FILE) /= TWO THEN
 120                          FAILED ("LINE NOT TWO; IS " &
 121                                  COUNT'IMAGE(LINE(FILE)));
 122                     END IF;
 123
 124                     IF PAGE (FILE) /= THREE THEN
 125                          FAILED ("PAGE NOT THREE; IS " &
 126                                  COUNT'IMAGE(PAGE(FILE)));
 127                     END IF;
 128
 129                END IF;
 130           END IF;
 131
 132           CHECK_FILE (FILE, "###C####DE#@##@#XY#@%");
 133
 134           CLOSE (FILE);
 135
 136           BEGIN
 137                OPEN (FILE, IN_FILE, LEGAL_FILE_NAME);
 138           EXCEPTION
 139                WHEN USE_ERROR =>
 140                     NOT_APPLICABLE ("USE_ERROR RAISED FOR TEXT OPEN " &
 141                                     "WITH IN_FILE MODE");
 142                     RAISE INCOMPLETE;
 143           END;
 144
 145           SET_LINE (FILE, FOUR);
 146           IF LINE (FILE) /= FOUR THEN
 147                FAILED ("FOR IN_FILE LINE NOT FOUR");
 148           ELSE
 149                GET (FILE, ITEM_CHAR);
 150                IF ITEM_CHAR /= 'C' THEN
 151                     FAILED ("SET_LINE FOR READ; ACTUALLY READ '" &
 152                             ITEM_CHAR & "'");
 153                END IF;
 154
 155                SKIP_LINE (FILE);
 156                SET_LINE (FILE, 5);
 157                IF LINE (FILE) /= FOUR+1 OR PAGE (FILE) /= ONE THEN
 158                     FAILED ("INCORRECT LINE OR PAGE");
 159                ELSE
 160                     SET_LINE (FILE, 8);
 161                     GET (FILE, ITEM_CHAR);
 162                     IF ITEM_CHAR /= 'D' THEN
 163                          FAILED ("SET_LINE FOR READ 2; ACTUALLY READ '"&
 164                                  ITEM_CHAR & "'");
 165                     END IF;
 166
 167                     SET_LINE (FILE, TWO);
 168                     IF PAGE (FILE) /= TWO THEN
 169                          FAILED ("FOR IN_FILE PAGE NOT TWO");
 170                     END IF;
 171
 172                     SET_LINE (FILE, TWO);
 173                     IF PAGE (FILE) /= TWO OR LINE (FILE) /= TWO THEN
 174                          FAILED ("FOR IN_FILE PAGE NOT 2");
 175                     END IF;
 176
 177                     SKIP_LINE (FILE);
 178                     SET_LINE (FILE, TWO);
 179
 180                     GET (FILE, ITEM_CHAR);
 181
 182                     IF ITEM_CHAR /= 'X' THEN
 183                          FAILED ("SET_LINE FOR READ 3; ACTUALLY READ '"&
 184                                  ITEM_CHAR & "'");
 185                     END IF;
 186
 187                END IF;
 188           END IF;
 189
 190           BEGIN
 191                DELETE (FILE);
 192           EXCEPTION
 193                WHEN USE_ERROR =>
 194                     NULL;
 195           END;
 196
 197      EXCEPTION
 198           WHEN INCOMPLETE =>
 199                NULL;
 200
 201      END;
 202
 203      RESULT;
 204
 205 END CE3410C;