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

   1 -- CE3303A.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_LENGTH, SET_PAGE_LENGTH, LINE_LENGTH, AND
  27 --     PAGE_LENGTH RAISE STATUS_ERROR WHEN APPLIED TO A CLOSED FILE.
  28
  29 -- HISTORY:
  30 --     ABW 08/26/82
  31 --     SPS 09/16/82
  32 --     JLH 08/19/87  ADDED AN ATTEMPT TO CREATE AN EXTERNAL FILE;
  33 --                   ADDED CHECKS TO THE SAME FOUR CASES WHICH EXIST
  34 --                   IN TEST AGAINST ATTEMPTED CREATE.
  35
  36 WITH REPORT;
  37 USE REPORT;
  38 WITH TEXT_IO;
  39 USE TEXT_IO;
  40
  41 PROCEDURE CE3303A IS
  42
  43      FILE : FILE_TYPE;
  44      FIVE : COUNT := COUNT(IDENT_INT(5));
  45      C : COUNT;
  46      ITEM : CHARACTER := 'A';
  47
  48 BEGIN
  49
  50      TEST ("CE3303A" , "CHECK THAT SET_LINE_LENGTH, " &
  51                        "SET_PAGE_LENGTH, LINE_LENGTH, AND " &
  52                        "PAGE_LENGTH RAISE STATUS_ERROR " &
  53                        "WHEN APPLIED TO A CLOSED FILE");
  54
  55 -- FILE NONEXISTANT
  56
  57      BEGIN
  58           SET_LINE_LENGTH (FILE, FIVE);
  59           FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 1");
  60      EXCEPTION
  61           WHEN STATUS_ERROR =>
  62                NULL;
  63           WHEN OTHERS =>
  64                FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " &
  65                        "- 1");
  66      END;
  67
  68      BEGIN
  69           SET_PAGE_LENGTH (FILE, FIVE);
  70           FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 1");
  71      EXCEPTION
  72           WHEN STATUS_ERROR =>
  73                NULL;
  74           WHEN OTHERS =>
  75                FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " &
  76                        "- 1");
  77      END;
  78
  79      BEGIN
  80           C := LINE_LENGTH (FILE);
  81           FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 1");
  82      EXCEPTION
  83           WHEN STATUS_ERROR =>
  84                NULL;
  85           WHEN OTHERS =>
  86                FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 1");
  87      END;
  88
  89      BEGIN
  90           C := PAGE_LENGTH (FILE);
  91           FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 1");
  92      EXCEPTION
  93           WHEN STATUS_ERROR =>
  94                NULL;
  95           WHEN OTHERS =>
  96                FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 1");
  97      END;
  98
  99      BEGIN
 100           CREATE (FILE, OUT_FILE);
 101           PUT (FILE, ITEM);
 102           CLOSE (FILE);
 103      EXCEPTION
 104           WHEN USE_ERROR =>
 105                NULL;
 106      END;
 107
 108      BEGIN
 109           SET_LINE_LENGTH (FILE, FIVE);
 110           FAILED ("STATUS_ERROR NOT RAISED FOR SET_LINE_LENGTH - 2");
 111      EXCEPTION
 112           WHEN STATUS_ERROR =>
 113                NULL;
 114           WHEN OTHERS =>
 115                FAILED ("OTHER EXCEPTION RAISED FOR SET_LINE_LENGTH " &
 116                        "- 2");
 117      END;
 118
 119      BEGIN
 120           SET_PAGE_LENGTH (FILE, FIVE);
 121           FAILED ("STATUS_ERROR NOT RAISED FOR SET_PAGE_LENGTH - 2");
 122      EXCEPTION
 123           WHEN STATUS_ERROR =>
 124                NULL;
 125           WHEN OTHERS =>
 126                FAILED ("OTHER EXCEPTION RAISED FOR SET_PAGE_LENGTH " &
 127                        "- 2");
 128      END;
 129
 130      BEGIN
 131           C := LINE_LENGTH (FILE);
 132           FAILED ("STATUS_ERROR NOT RAISED FOR LINE_LENGTH - 2");
 133      EXCEPTION
 134           WHEN STATUS_ERROR =>
 135                NULL;
 136           WHEN OTHERS =>
 137                FAILED ("OTHER EXCEPTION RAISED FOR LINE_LENGTH - 2");
 138      END;
 139
 140      BEGIN
 141           C := PAGE_LENGTH (FILE);
 142           FAILED ("STATUS_ERROR NOT RAISED FOR PAGE_LENGTH - 2");
 143      EXCEPTION
 144           WHEN STATUS_ERROR =>
 145                NULL;
 146           WHEN OTHERS =>
 147                FAILED ("OTHER EXCEPTION RAISED FOR PAGE_LENGTH - 2");
 148      END;
 149
 150      RESULT;
 151
 152 END CE3303A;