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

   1 -- CE2102K.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 USE_ERROR IS RAISED IF AN IMPLEMENTATION DOES NOT
  27 --     SUPPORT RESET FOR DIRECT_IO.
  28
  29 -- APPLICABILITY CRITERIA:
  30 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  31 --     DIRECT FILES.
  32
  33 -- HISTORY:
  34 --     TBN 02/12/86  CREATED ORIGINAL TEST.
  35 --     TBN 09/15/87  COMPLETELY REVISED TEST.
  36
  37 WITH DIRECT_IO;
  38 WITH REPORT; USE REPORT;
  39 PROCEDURE CE2102K IS
  40      INCOMPLETE : EXCEPTION;
  41 BEGIN
  42      TEST ("CE2102K", "CHECK THAT USE_ERROR IS RAISED IF AN " &
  43                       "IMPLEMENTATION DOES NOT SUPPORT RESET FOR " &
  44                       "DIRECT_IO");
  45      DECLARE
  46           PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
  47           USE DIR;
  48           FILE1 : FILE_TYPE;
  49           INT1 : INTEGER := IDENT_INT(1);
  50           INT2 : INTEGER := 2;
  51      BEGIN
  52           BEGIN
  53                CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME);
  54           EXCEPTION
  55                WHEN USE_ERROR =>
  56                     NOT_APPLICABLE ("USE_ERROR RAISED ON CREATE OF " &
  57                                     "DIRECT FILE WITH OUT_FILE MODE");
  58                     RAISE INCOMPLETE;
  59                WHEN NAME_ERROR =>
  60                     NOT_APPLICABLE ("NAME_ERROR RAISED ON CREATE OF " &
  61                                     "DIRECT FILE WITH OUT_FILE MODE");
  62                     RAISE INCOMPLETE;
  63           END;
  64
  65           WRITE (FILE1, INT2);
  66
  67      -- RESETTING FROM OUT_FILE TO IN_FILE.
  68
  69           BEGIN
  70                RESET (FILE1, IN_FILE);
  71                COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS ALLOWED");
  72                BEGIN
  73                     READ (FILE1, INT1);
  74                     IF INT1 /= IDENT_INT(2) THEN
  75                          FAILED ("RESETTING FROM OUT_FILE TO IN_FILE " &
  76                                  "AFFECTED DATA");
  77                     END IF;
  78                EXCEPTION
  79                     WHEN OTHERS =>
  80                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
  81                                  "READING FROM FILE - 1");
  82                END;
  83           EXCEPTION
  84                WHEN USE_ERROR =>
  85                     COMMENT ("RESET FROM OUT_FILE TO IN_FILE IS NOT " &
  86                              "ALLOWED");
  87                WHEN OTHERS =>
  88                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
  89                             "RESETTING FROM OUT_FILE TO IN_FILE");
  90           END;
  91
  92           CLOSE (FILE1);
  93
  94      -- RESETTING FROM OUT_FILE TO INOUT_FILE.
  95
  96           CREATE (FILE1, OUT_FILE, LEGAL_FILE_NAME(2));
  97
  98           WRITE (FILE1, INT2);
  99           BEGIN
 100                RESET (FILE1, INOUT_FILE);
 101                COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS ALLOWED");
 102                BEGIN
 103                     READ (FILE1, INT1);
 104                     IF INT1 /= IDENT_INT(2) THEN
 105                          FAILED ("RESETTING FROM OUT_FILE TO " &
 106                                  "INOUT_FILE AFFECTED DATA");
 107                     END IF;
 108                EXCEPTION
 109                     WHEN OTHERS =>
 110                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
 111                                  "READING FROM FILE - 2");
 112                END;
 113           EXCEPTION
 114                WHEN USE_ERROR =>
 115                     COMMENT ("RESET FROM OUT_FILE TO INOUT_FILE IS " &
 116                              "NOT ALLOWED");
 117                WHEN OTHERS =>
 118                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
 119                             "RESETTING FROM OUT_FILE TO INOUT_FILE");
 120           END;
 121
 122           BEGIN
 123                DELETE (FILE1);
 124           EXCEPTION
 125                WHEN USE_ERROR =>
 126                     NULL;
 127           END;
 128
 129      -- RESETTING FROM IN_FILE TO OUT_FILE.
 130
 131           BEGIN
 132                OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
 133           EXCEPTION
 134                WHEN USE_ERROR =>
 135                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
 136                                     "DIRECT FILE WITH IN_FILE MODE");
 137                     RAISE INCOMPLETE;
 138           END;
 139
 140           BEGIN
 141                RESET (FILE1, OUT_FILE);
 142                COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS ALLOWED");
 143           EXCEPTION
 144                WHEN USE_ERROR =>
 145                     COMMENT ("RESET FROM IN_FILE TO OUT_FILE IS NOT " &
 146                              "ALLOWED");
 147                WHEN OTHERS =>
 148                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
 149                             "RESETTING FROM IN_FILE TO OUT_FILE");
 150           END;
 151
 152           CLOSE (FILE1);
 153
 154      -- RESETTING FROM IN_FILE TO INOUT_FILE.
 155
 156           OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
 157
 158           BEGIN
 159                RESET (FILE1, INOUT_FILE);
 160                COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS ALLOWED");
 161                BEGIN
 162                     READ (FILE1, INT1);
 163                     IF INT1 /= IDENT_INT(2) THEN
 164                          FAILED ("RESETTING FROM IN_FILE TO " &
 165                                  "INOUT_FILE AFFECTED DATA");
 166                     END IF;
 167                EXCEPTION
 168                     WHEN OTHERS =>
 169                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
 170                                  "READING FROM FILE - 3");
 171                END;
 172           EXCEPTION
 173                WHEN USE_ERROR =>
 174                     COMMENT ("RESET FROM IN_FILE TO INOUT_FILE IS " &
 175                              "NOT ALLOWED");
 176                WHEN OTHERS =>
 177                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
 178                             "RESETTING FROM IN_FILE TO INOUT_FILE");
 179           END;
 180
 181           CLOSE (FILE1);
 182
 183      -- RESETTING FROM INOUT_FILE TO IN_FILE.
 184
 185           BEGIN
 186                OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
 187           EXCEPTION
 188                WHEN USE_ERROR =>
 189                     NOT_APPLICABLE ("USE_ERROR RAISED ON OPENING OF " &
 190                                     "DIRECT FILE WITH INOUT_FILE MODE");
 191                     RAISE INCOMPLETE;
 192           END;
 193
 194           BEGIN
 195                RESET (FILE1, IN_FILE);
 196                COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS ALLOWED");
 197                BEGIN
 198                     READ (FILE1, INT1);
 199                     IF INT1 /= IDENT_INT(2) THEN
 200                          FAILED ("RESETTING FROM INOUT_FILE TO " &
 201                                  "IN_FILE AFFECTED DATA");
 202                     END IF;
 203                EXCEPTION
 204                     WHEN OTHERS =>
 205                          FAILED ("UNEXPECTED EXCEPTION RAISED WHILE " &
 206                                  "READING FROM FILE - 2");
 207                END;
 208           EXCEPTION
 209                WHEN USE_ERROR =>
 210                     COMMENT ("RESET FROM INOUT_FILE TO IN_FILE IS " &
 211                              "NOT ALLOWED");
 212                WHEN OTHERS =>
 213                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
 214                             "RESETTING FROM INOUT_FILE TO IN_FILE");
 215           END;
 216
 217           CLOSE (FILE1);
 218
 219      -- RESETTING FROM INOUT_FILE TO OUT_FILE.
 220
 221           OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
 222
 223           BEGIN
 224                RESET (FILE1, OUT_FILE);
 225                COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS ALLOWED");
 226           EXCEPTION
 227                WHEN USE_ERROR =>
 228                     COMMENT ("RESET FROM INOUT_FILE TO OUT_FILE IS " &
 229                              "NOT ALLOWED");
 230                WHEN OTHERS =>
 231                     FAILED ("UNEXPECTED EXCEPTION RAISED WHEN " &
 232                             "RESETTING FROM INOUT_FILE TO OUT_FILE");
 233           END;
 234
 235           BEGIN
 236                DELETE (FILE1);
 237           EXCEPTION
 238                WHEN USE_ERROR =>
 239                     NULL;
 240           END;
 241
 242      EXCEPTION
 243           WHEN INCOMPLETE =>
 244                NULL;
 245      END;
 246
 247      RESULT;
 248 END CE2102K;