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

   1 -- CE3602C.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 GET RAISES MODE_ERROR FOR FILES OF MODE OUT_FILE.
  27
  28 -- APPLICABILITY CRITEIRA:
  29 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  30 --     TEXT FILES.
  31
  32 -- HISTORY:
  33 --     SPS 08/31/82
  34 --     SPS 12/17/82
  35 --     JBG 02/22/84  CHANGED TO .ADA TEST
  36 --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
  37 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  38 --     JLH 09/08/87  CORRECTED EXCEPTION HANDLING AND CHECKED FOR
  39 --                   USE_ERROR ON DELETE.
  40
  41 WITH REPORT;
  42 USE REPORT;
  43 WITH TEXT_IO;
  44 USE TEXT_IO;
  45
  46 PROCEDURE CE3602C IS
  47      INCOMPLETE : EXCEPTION;
  48
  49 BEGIN
  50
  51      TEST ("CE3602C", "CHECK THAT MODE_ERROR IS RAISED BY GET FOR " &
  52                       "FILES OF MODE OUT_FILE");
  53
  54      DECLARE
  55           FILE1, FILE2 : FILE_TYPE;
  56           CH : CHARACTER;
  57           ST : STRING (1 .. 5);
  58      BEGIN
  59
  60           BEGIN
  61                CREATE (FILE1, OUT_FILE);
  62           EXCEPTION
  63                WHEN USE_ERROR =>
  64                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
  65                                     "FOR TEMPORARY FILE WITH " &
  66                                     "OUT_FILE MODE");
  67                     RAISE INCOMPLETE;
  68                WHEN OTHERS =>
  69                     FAILED ("UNEXPECTED EXCEPTION RAISED ON " &
  70                             "TEXT CREATE - 1");
  71                     RAISE INCOMPLETE;
  72           END;
  73
  74           BEGIN
  75                CREATE (FILE2, OUT_FILE, LEGAL_FILE_NAME);
  76           EXCEPTION
  77                WHEN USE_ERROR =>
  78                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
  79                                     "WITH OUT_FILE MODE");
  80                     RAISE INCOMPLETE;
  81                WHEN NAME_ERROR =>
  82                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
  83                                     "CREATE WITH OUT_FILE MODE");
  84                     RAISE INCOMPLETE;
  85                WHEN OTHERS =>
  86                     FAILED ("UNEXPECTED EXCEPTION RAISED ON TEXT " &
  87                             "CREATE - 2");
  88                     RAISE INCOMPLETE;
  89           END;
  90
  91           BEGIN
  92                GET (FILE1, CH);
  93                FAILED ("MODE_ERROR NOT RAISED - GET CHAR UN-NAMED " &
  94                        "FILE");
  95           EXCEPTION
  96                WHEN MODE_ERROR =>
  97                     NULL;
  98                WHEN OTHERS =>
  99                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
 100                             "UN-NAMED FILE");
 101           END;
 102
 103           BEGIN
 104                GET (FILE2, CH);
 105                FAILED ("MODE_ERROR NOT RAISED - GET CHAR NAMED FILE");
 106           EXCEPTION
 107                WHEN MODE_ERROR =>
 108                     NULL;
 109                WHEN OTHERS =>
 110                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
 111                             "NAMED FILE");
 112           END;
 113
 114           BEGIN
 115                GET (STANDARD_OUTPUT, CH);
 116                FAILED ("MODE_ERROR NOT RAISED - GET CHAR " &
 117                        "STANDARD_OUTPUT");
 118           EXCEPTION
 119                WHEN MODE_ERROR =>
 120                     NULL;
 121                WHEN OTHERS =>
 122                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
 123                             "STANDARD_OUTPUT");
 124           END;
 125
 126           BEGIN
 127                GET (CURRENT_OUTPUT, CH);
 128                FAILED ("MODE_ERROR NOT RAISED - GET CHAR " &
 129                        "CURRENT_OUTPUT");
 130           EXCEPTION
 131                WHEN MODE_ERROR =>
 132                     NULL;
 133                WHEN OTHERS =>
 134                     FAILED ("WRONG EXCEPTION RAISED - GET CHAR " &
 135                             "CURRENT_OUTPUT");
 136           END;
 137
 138           BEGIN
 139                GET (FILE1, ST);
 140                FAILED ("MODE_ERROR NOT RAISED - GET STRING UN-NAMED " &
 141                        "FILE");
 142           EXCEPTION
 143                WHEN MODE_ERROR =>
 144                     NULL;
 145                WHEN OTHERS =>
 146                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
 147                             "UN-NAMED FILE");
 148           END;
 149
 150           BEGIN
 151                GET (FILE2, ST);
 152                FAILED ("MODE_ERROR NOT RAISED - GET STRING NAMED FILE");
 153           EXCEPTION
 154                WHEN MODE_ERROR =>
 155                     NULL;
 156                WHEN OTHERS =>
 157                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
 158                             "NAMED FILE");
 159           END;
 160
 161           BEGIN
 162                GET (STANDARD_OUTPUT, ST);
 163                FAILED ("MODE_ERROR NOT RAISED - GET STRING " &
 164                        "STANDARD_OUTPUT");
 165           EXCEPTION
 166                WHEN MODE_ERROR =>
 167                     NULL;
 168                WHEN OTHERS =>
 169                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
 170                             "STANDARD_OUTPUT");
 171           END;
 172
 173           BEGIN
 174                GET (CURRENT_OUTPUT, ST);
 175                FAILED ("MODE_ERROR NOT RAISED - GET STRING " &
 176                        "CURRENT_OUTPUT");
 177           EXCEPTION
 178                WHEN MODE_ERROR =>
 179                     NULL;
 180                WHEN OTHERS =>
 181                     FAILED ("WRONG EXCEPTION RAISED - GET STRING " &
 182                             "CURRENT_OUTPUT");
 183           END;
 184
 185           CLOSE (FILE1);
 186
 187           BEGIN
 188                DELETE (FILE2);
 189           EXCEPTION
 190                WHEN USE_ERROR =>
 191                     NULL;
 192           END;
 193
 194      EXCEPTION
 195           WHEN INCOMPLETE =>
 196                NULL;
 197
 198      END;
 199
 200      RESULT;
 201
 202 END CE3602C;