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

   1 -- CE2102B.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 TO SEE THAT STATUS_ERROR IS RAISED WHEN PERFORMING ILLEGAL
  27 --     OPERATIONS ON OPENED OR UNOPENED FILES OF TYPE DIRECT_IO.
  28
  29 --          A) OPENED FILES
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO THOSE  IMPLEMENTATIONS WHICH
  33 --     SUPPORT CREATE WITH OUT_FILE MODE FOR DIRECT FILES.
  34
  35 -- HISTORY:
  36 --     DLD 08/10/82
  37 --     SPS 11/03/82
  38 --     JBG 02/22/84
  39 --     SPW 08/13/87  SPLIT CASE FOR UNOPENED FILES INTO CE2102M.ADA.
  40
  41 WITH REPORT; USE REPORT;
  42 WITH DIRECT_IO;
  43
  44 PROCEDURE CE2102B IS
  45
  46      PACKAGE DIR_IO IS NEW DIRECT_IO(INTEGER);
  47      USE DIR_IO;
  48      TEST_FILE_ONE : DIR_IO.FILE_TYPE;
  49
  50 BEGIN
  51
  52      TEST ("CE2102B", "CHECK THAT STATUS_ERROR IS RAISED WHEN " &
  53                       "PERFORMING ILLEGAL OPERATIONS ON FILES " &
  54                       "OF TYPE DIRECT_IO");
  55
  56      BEGIN
  57           CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
  58
  59 -- CHECK THAT OPEN STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY OPEN
  60
  61           BEGIN
  62                OPEN (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
  63                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
  64                        "ALREADY OPEN - 1");
  65           EXCEPTION
  66                WHEN STATUS_ERROR =>
  67                     NULL;
  68                WHEN OTHERS =>
  69                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 1");
  70           END;
  71
  72           BEGIN
  73                OPEN (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
  74                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
  75                        "ALREADY OPEN - 2");
  76           EXCEPTION
  77                WHEN STATUS_ERROR =>
  78                     NULL;
  79                WHEN OTHERS =>
  80                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 2");
  81           END;
  82
  83           BEGIN
  84                OPEN (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
  85                FAILED ("STATUS_ERROR NOT RAISED WHEN FILE IS " &
  86                        "ALREADY OPEN - 3");
  87           EXCEPTION
  88                WHEN STATUS_ERROR =>
  89                     NULL;
  90                WHEN OTHERS =>
  91                     FAILED ("WRONG EXCEPTION RAISED ON OPEN - 3");
  92           END;
  93
  94 -- CHECK THAT CREATE STATEMENT RAISES EXCEPTION WHEN FILE IS ALREADY
  95 -- OPEN
  96
  97           BEGIN
  98                CREATE (TEST_FILE_ONE, IN_FILE, LEGAL_FILE_NAME);
  99                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
 100                        "FILE IS USED IN A CREATE - 1");
 101           EXCEPTION
 102                WHEN STATUS_ERROR =>
 103                     NULL;
 104                WHEN OTHERS =>
 105                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 1");
 106           END;
 107
 108           BEGIN
 109                CREATE (TEST_FILE_ONE, OUT_FILE, LEGAL_FILE_NAME);
 110                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
 111                        "FILE IS USED IN A CREATE - 2");
 112           EXCEPTION
 113                WHEN STATUS_ERROR =>
 114                     NULL;
 115                WHEN OTHERS =>
 116                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
 117           END;
 118
 119           BEGIN
 120                CREATE (TEST_FILE_ONE, INOUT_FILE, LEGAL_FILE_NAME);
 121                FAILED ("STATUS_ERROR NOT RAISED WHEN AN OPEN " &
 122                        "FILE IS USED IN A CREATE - 3");
 123           EXCEPTION
 124                WHEN STATUS_ERROR =>
 125                     NULL;
 126                WHEN OTHERS =>
 127                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 3");
 128           END;
 129
 130 --DELETE TEST FILE
 131
 132           BEGIN
 133                DELETE (TEST_FILE_ONE);
 134           EXCEPTION
 135                WHEN USE_ERROR =>
 136                     COMMENT ("DELETION OF EXTERNAL FILE APPEARS NOT " &
 137                              "TO BE SUPPORTED");
 138                WHEN OTHERS =>
 139                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR DELETE");
 140           END;
 141
 142      EXCEPTION
 143           WHEN USE_ERROR =>
 144                NOT_APPLICABLE ("USE_ERROR RAISED FOR CREATE " &
 145                                "WITH OUT_FILE MODE");
 146           WHEN NAME_ERROR =>
 147                NOT_APPLICABLE ("NAME_ERROR RAISED FOR CREATE " &
 148                                "WITH OUT_FILE MODE");
 149           WHEN OTHERS =>
 150                FAILED ("OTHER EXCEPTION RAISED FOR CREATE");
 151      END;
 152
 153      RESULT;
 154
 155 END CE2102B;