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

   1 -- CE2102H.TST
   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 NAME_ERROR IS RAISED WHEN THE NAME STRING DOES NOT
  27 --     IDENTIFY AN EXTERNAL FILE FOR AN OPEN OR CREATE OPERATION FOR
  28 --     DIRECT_IO.
  29
  30 -- APPLICABILITY CRITERIA:
  31 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  32 --     CREATE WITH INOUT_FILE MODE FOR TEMPORARY DIRECT FILES.
  33
  34 -- HISTORY:
  35 --     TBN 02/12/86
  36 --     SPW 08/26/87  CORRECTED EXCEPTION HANDLING.
  37 --     BCB 09/28/88  ADDED EXCEPTION HANDLERS FOR DELETE STATEMENTS.
  38
  39 WITH REPORT; USE REPORT;
  40 WITH DIRECT_IO;
  41
  42 PROCEDURE CE2102H IS
  43
  44      NAME1 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME1";
  45                -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
  46                -- CONTAINS INVALID CHARACTERS OR IS TOO LONG.
  47
  48      NAME2 : CONSTANT STRING := "$ILLEGAL_EXTERNAL_FILE_NAME2";
  49                -- AN ILLEGAL EXTERNAL FILE NAME THAT EITHER (PREFERABLY)
  50                -- CONTAINS A WILD CARD CHARACTER OR IS TOO LONG.
  51
  52 BEGIN
  53
  54      TEST ("CE2102H", "CHECK THAT NAME_ERROR IS RAISED BY OPEN AND " &
  55                       "CREATE WHEN NAME DOES NOT IDENTIFY AN " &
  56                       "EXTERNAL FILE FOR DIRECT_IO");
  57
  58      DECLARE
  59           PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
  60           USE DIR;
  61           FILE1 : FILE_TYPE;
  62           INCOMPLETE : EXCEPTION;
  63      BEGIN
  64
  65 -- CHECK WHETHER CREATE RAISES USE_ERROR
  66
  67           BEGIN
  68                CREATE (FILE1);
  69           EXCEPTION
  70                WHEN USE_ERROR =>
  71                     NOT_APPLICABLE ("TEMPORARY DIRECT FILES WITH " &
  72                                     "INOUT_FILE MODE NOT SUPPORTED");
  73                     RAISE INCOMPLETE;
  74                WHEN OTHERS =>
  75                     FAILED ("UNEXPECTED EXCEPTION RAISED FOR CREATE");
  76                     RAISE INCOMPLETE;
  77           END;
  78           CLOSE (FILE1);
  79
  80           BEGIN
  81                CREATE(FILE1, OUT_FILE, NAME1);
  82                FAILED ("NAME_ERROR NOT RAISED - CREATE DIR 1");
  83                BEGIN
  84                     DELETE (FILE1);
  85                EXCEPTION
  86                     WHEN USE_ERROR =>
  87                          NULL;
  88                END;
  89           EXCEPTION
  90                WHEN NAME_ERROR =>
  91                     NULL;
  92                WHEN USE_ERROR =>
  93                     FAILED ("USE_ERROR RAISED - CREATE DIR 1");
  94                WHEN OTHERS =>
  95                     FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 1");
  96           END;
  97
  98           BEGIN
  99                CREATE (FILE1, OUT_FILE, NAME2);
 100                FAILED("NAME_ERROR NOT RAISED - CREATE DIR 2");
 101                BEGIN
 102                     DELETE (FILE1);
 103                EXCEPTION
 104                     WHEN USE_ERROR =>
 105                          NULL;
 106                END;
 107           EXCEPTION
 108                WHEN NAME_ERROR =>
 109                     NULL;
 110                WHEN USE_ERROR =>
 111                     FAILED ("USE_ERROR RAISED - CREATE DIR 2");
 112                WHEN OTHERS =>
 113                     FAILED ("WRONG EXCEPTION RAISED - CREATE DIR 2");
 114           END;
 115
 116 -- CHECK WHETHER OPEN RAISES NAME_ERROR IN THE CASE OF A LEGAL FILE NAME
 117 -- BUT A NON-EXISTENT FILE.
 118
 119           BEGIN
 120                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
 121                FAILED("NAME_ERROR NOT RAISED - OPEN DIR");
 122           EXCEPTION
 123                WHEN NAME_ERROR =>
 124                     NULL;
 125                WHEN USE_ERROR =>
 126                     FAILED ("USE_ERROR RAISED - OPEN DIR");
 127                WHEN OTHERS =>
 128                     FAILED ("WRONG EXCEPTION RAISED - OPEN DIR");
 129           END;
 130      EXCEPTION
 131           WHEN INCOMPLETE =>
 132                NULL;
 133      END;
 134
 135      RESULT;
 136 END CE2102H;