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

   1 -- CE3305A.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 LINE AND PAGE LENGTHS MAY BE ALTERED DYNAMICALLY
  27 --     SEVERAL TIMES.  CHECK THAT WHEN RESET TO ZERO, THE LENGTHS ARE
  28 --     UNBOUNDED.
  29
  30 -- APPLICABILITY CRITERIA:
  31 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  32 --     TEXT FILES WITH UNBOUNDED LINE LENGTH.
  33
  34 -- HISTORY:
  35 --     SPS 09/28/82
  36 --     EG  05/22/85
  37 --     DWC 08/18/87  ADDED CHECK_FILE WITHOUT A'S.
  38
  39 WITH REPORT; USE REPORT;
  40 WITH TEXT_IO; USE TEXT_IO;
  41 WITH CHECK_FILE;
  42
  43 PROCEDURE CE3305A IS
  44
  45      INCOMPLETE : EXCEPTION;
  46
  47 BEGIN
  48
  49      TEST ("CE3305A", "CHECK THAT LINE AND PAGE LENGTHS MAY BE " &
  50                       "ALTERED DYNAMICALLY");
  51
  52      DECLARE
  53           FT : FILE_TYPE;
  54
  55           PROCEDURE PUT_CHARS (CNT: INTEGER; CH: CHARACTER) IS
  56           BEGIN
  57                FOR I IN 1 .. CNT LOOP
  58                     PUT (FT, CH);
  59                END LOOP;
  60           END PUT_CHARS;
  61
  62      BEGIN
  63
  64           BEGIN
  65                CREATE(FT, OUT_FILE, LEGAL_FILE_NAME);
  66           EXCEPTION
  67                WHEN USE_ERROR =>
  68                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE " &
  69                                     "WITH OUT_FILE MODE");
  70                     RAISE INCOMPLETE;
  71                WHEN NAME_ERROR =>
  72                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE " &
  73                                     "WITH OUT_FILE MODE");
  74                     RAISE INCOMPLETE;
  75                WHEN OTHERS =>
  76                     FAILED ("UNEXPECTED EXCEPTION RAISED ON CREATE");
  77                     RAISE INCOMPLETE;
  78           END;
  79
  80           SET_LINE_LENGTH (FT, 10);
  81           SET_PAGE_LENGTH (FT, 5);
  82
  83           PUT_CHARS (150, 'X');         -- 15 LINES
  84
  85           BEGIN
  86                SET_LINE_LENGTH (FT, 5);
  87                SET_PAGE_LENGTH (FT, 10);
  88           EXCEPTION
  89                WHEN OTHERS =>
  90                     FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH");
  91           END;
  92
  93           PUT_CHARS (50, 'B');               -- 10 LINES
  94
  95           BEGIN
  96                SET_LINE_LENGTH (FT, 25);
  97                SET_PAGE_LENGTH (FT,4);
  98           EXCEPTION
  99                WHEN OTHERS =>
 100                     FAILED ("UNABLE TO CHANGE LINE OR PAGE LENGTH - 2");
 101           END;
 102
 103           PUT_CHARS (310, 'K');              -- 12 LINES, 10 CHARACTERS
 104
 105 --  THIS CAN RAISE USE_ERROR IF AN IMPLEMENTATION REQUIRES A BOUNDED
 106 --  LINE LENGTH FOR AN EXTERNAL FILE.
 107
 108           BEGIN
 109                BEGIN
 110                     SET_LINE_LENGTH (FT, UNBOUNDED);
 111                     SET_PAGE_LENGTH (FT, UNBOUNDED);
 112                EXCEPTION
 113                     WHEN USE_ERROR =>
 114                          NOT_APPLICABLE ("BOUNDED LINE LENGTH " &
 115                                          "REQUIRED");
 116                          RAISE INCOMPLETE;
 117                END;
 118
 119                PUT_CHARS (100, 'A');              -- ONE LINE
 120
 121                CHECK_FILE (FT,"XXXXXXXXXX#" &
 122                               "XXXXXXXXXX#" &
 123                               "XXXXXXXXXX#" &
 124                               "XXXXXXXXXX#" &
 125                               "XXXXXXXXXX#@" &
 126                               "XXXXXXXXXX#" &
 127                               "XXXXXXXXXX#" &
 128                               "XXXXXXXXXX#" &
 129                               "XXXXXXXXXX#" &
 130                               "XXXXXXXXXX#@" &
 131                               "XXXXXXXXXX#" &
 132                               "XXXXXXXXXX#" &
 133                               "XXXXXXXXXX#" &
 134                               "XXXXXXXXXX#" &
 135                               "XXXXXXXXXX#" &
 136                               "BBBBB#" &
 137                               "BBBBB#" &
 138                               "BBBBB#" &
 139                               "BBBBB#" &
 140                               "BBBBB#@" &
 141                               "BBBBB#" &
 142                               "BBBBB#" &
 143                               "BBBBB#" &
 144                               "BBBBB#" &
 145                               "BBBBBKKKKKKKKKKKKKKKKKKKK#@" &
 146                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
 147                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
 148                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
 149                               "KKKKKKKKKKKKKKKKKKKKKKKKK#@" &
 150                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
 151                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
 152                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
 153                               "KKKKKKKKKKKKKKKKKKKKKKKKK#@" &
 154                               "KKKKKKKKKKKKKKKKKKKKKKKKK#" &
 155                               "KKKKKKKKKKKKKKKKKKKKKKKKK#"&
 156                               "KKKKKKKKKKKKKKKKKKKKKKKKK#"&
 157                               "KKKKKKKKKKKKKKKAAAAAAAAAAA" &
 158                               "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
 159                               "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
 160                               "AAAAAAAAAAAAAAAAAAAAAAAAAA" &
 161                               "AAAAAAAAAAA#@%");
 162
 163           EXCEPTION
 164                WHEN INCOMPLETE =>
 165                     NULL;
 166           END;
 167
 168           BEGIN
 169                DELETE (FT);
 170           EXCEPTION
 171                WHEN USE_ERROR =>
 172                     NULL;
 173           END;
 174
 175      EXCEPTION
 176           WHEN INCOMPLETE =>
 177                NULL;
 178      END;
 179
 180      RESULT;
 181
 182 END CE3305A;