gomp-20050608-branch/gcc/testsuite/ada/acats/tests/ce/ce2402a.ada

   1 -- CE2402A.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 READ, WRITE, INDEX, SET_INDEX, SIZE, AND
  27 --     END_OF_FILE RAISE STATUS_ERROR WHEN APPLIED TO A NON-OPEN
  28 --     DIRECT FILE.  USE_ERROR IS NOT PERMITTED.
  29
  30 -- HISTORY:
  31 --     ABW 08/17/82
  32 --     SPS 09/16/82
  33 --     SPS 11/09/82
  34 --     JBG 08/30/83
  35 --     EG  11/26/84
  36 --     EG  06/04/85
  37 --     GMT 08/03/87  CLARIFIED SOME OF THE FAILED MESSAGES, AND
  38 --                   REMOVED THE EXCEPTION FOR CONSTRAINT_ERROR.
  39
  40 WITH REPORT; USE REPORT;
  41 WITH DIRECT_IO;
  42
  43 PROCEDURE CE2402A IS
  44
  45      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
  46      USE DIR;
  47      FILE1   : FILE_TYPE;
  48      CNST    : CONSTANT INTEGER := 101;
  49      IVAL    : INTEGER;
  50      BOOL    : BOOLEAN;
  51      X_COUNT : COUNT;
  52      P_COUNT : POSITIVE_COUNT;
  53
  54 BEGIN
  55      TEST ("CE2402A","CHECK THAT READ, WRITE, INDEX, "   &
  56                      "SET_INDEX, SIZE, AND END_OF_FILE " &
  57                      "RAISE STATUS_ERROR WHEN APPLIED "  &
  58                      "A NON-OPEN DIRECT FILE");
  59      BEGIN
  60           WRITE (FILE1, CNST);
  61           FAILED ("STATUS_ERROR WAS NOT RAISED ON WRITE - 1");
  62      EXCEPTION
  63           WHEN STATUS_ERROR =>
  64                NULL;
  65           WHEN USE_ERROR =>
  66                FAILED ("USE_ERROR RAISED ON WRITE - 2");
  67           WHEN OTHERS =>
  68                FAILED ("UNEXPECTED EXCEPTION RAISED ON WRITE - 3");
  69      END;
  70
  71      BEGIN
  72           X_COUNT := SIZE (FILE1);
  73           FAILED ("STATUS_ERROR NOT RAISED ON SIZE - 4");
  74      EXCEPTION
  75           WHEN STATUS_ERROR =>
  76                NULL;
  77           WHEN USE_ERROR =>
  78                FAILED ("USE_ERROR RAISED ON SIZE - 5");
  79           WHEN OTHERS =>
  80                FAILED ("UNEXPECTED EXCEPTION RAISED ON SIZE - 6");
  81      END;
  82
  83      BEGIN
  84           BOOL := END_OF_FILE (FILE1);
  85           FAILED ("STATUS_ERROR WAS NOT RAISED ON END_OF_FILE - 7");
  86      EXCEPTION
  87           WHEN STATUS_ERROR =>
  88                NULL;
  89           WHEN USE_ERROR =>
  90                FAILED ("USE_ERROR RAISED ON END_OF_FILE - 8");
  91           WHEN OTHERS =>
  92                FAILED ("WRONG EXCEPTION RAISED ON END_OF_FILE - 9");
  93      END;
  94
  95      BEGIN
  96           P_COUNT := INDEX (FILE1);
  97           FAILED ("STATUS_ERROR WAS NOT RAISED ON INDEX - 10");
  98      EXCEPTION
  99           WHEN STATUS_ERROR =>
 100                NULL;
 101           WHEN USE_ERROR =>
 102                FAILED ("USE_ERROR RAISED ON INDEX - 11");
 103           WHEN OTHERS =>
 104                FAILED ("WRONG EXCEPTION RAISED ON INDEX - 12");
 105      END;
 106
 107      BEGIN
 108           READ (FILE1, IVAL);
 109           FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 13");
 110      EXCEPTION
 111           WHEN STATUS_ERROR =>
 112                NULL;
 113           WHEN USE_ERROR =>
 114                FAILED ("USE_ERROR RAISED ON READ - 14");
 115           WHEN OTHERS =>
 116                FAILED ("WRONG EXCEPTION RAISED ON READ - 15");
 117      END;
 118
 119      DECLARE
 120           ONE : POSITIVE_COUNT := POSITIVE_COUNT (IDENT_INT(1));
 121      BEGIN
 122           BEGIN
 123                WRITE (FILE1, CNST, ONE);
 124                FAILED ("STATUS_ERROR NOT RAISED ON WRITE - 16");
 125           EXCEPTION
 126                WHEN STATUS_ERROR =>
 127                     NULL;
 128                WHEN USE_ERROR =>
 129                     FAILED ("USE_ERROR RAISED ON WRITE - 17");
 130                WHEN OTHERS =>
 131                     FAILED ("WRONG EXCEPTION RAISED ON WRITE - 18");
 132           END;
 133
 134           BEGIN
 135                SET_INDEX (FILE1,ONE);
 136                FAILED ("STATUS_ERROR NOT RAISED ON SET_INDEX - 19");
 137           EXCEPTION
 138                WHEN STATUS_ERROR =>
 139                     NULL;
 140                WHEN USE_ERROR =>
 141                     FAILED ("USE_ERROR RAISED ON SET_INDEX - 20");
 142                WHEN OTHERS =>
 143                     FAILED ("WRONG EXCEPTION RAISED ON SET_INDEX - 21");
 144           END;
 145
 146           BEGIN
 147                READ (FILE1, IVAL, ONE);
 148                FAILED ("STATUS_ERROR WAS NOT RAISED ON READ - 22");
 149           EXCEPTION
 150                WHEN STATUS_ERROR =>
 151                     NULL;
 152                WHEN USE_ERROR =>
 153                     FAILED ("USE_ERROR RAISED ON READ - 23");
 154                WHEN OTHERS =>
 155                     FAILED ("WRONG EXCEPTION RAISED ON READ - 24");
 156           END;
 157      END;
 158
 159      RESULT;
 160
 161 END CE2402A;