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

   1 -- CE3601A.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 (FOR STRINGS AND CHARACTERS), PUT (FOR STRINGS AND
  27 --     CHARACTERS), GET_LINE, AND PUT_LINE RAISE STATUS_ERROR WHEN
  28 --     CALLED WITH AN UNOPEN FILE PARAMETER.  ALSO CHECK NAMES OF FORMAL
  29 --     PARAMETERS.
  30
  31 -- HISTORY:
  32 --     SPS 08/27/82
  33 --     VKG 02/15/83
  34 --     JBG 03/30/83
  35 --     JLH 09/04/87  ADDED CASE WHICH ATTEMPTS TO CREATE FILE AND THEN
  36 --                   RETESTED OBJECTIVE.
  37
  38 WITH REPORT; USE REPORT;
  39 WITH TEXT_IO; USE TEXT_IO;
  40
  41 PROCEDURE CE3601A IS
  42
  43 BEGIN
  44
  45      TEST ("CE3601A", "STATUS_ERROR RAISED BY GET, PUT, GET_LINE, " &
  46                       "PUT_LINE WHEN FILE IS NOT OPEN");
  47
  48      DECLARE
  49           FILE1, FILE2 : FILE_TYPE;
  50           CH: CHARACTER := '%';
  51           LST: NATURAL;
  52           ST: STRING (1 .. 10);
  53           LN : STRING (1 .. 80);
  54      BEGIN
  55           BEGIN
  56                GET (FILE => FILE1, ITEM => CH);
  57                FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER");
  58           EXCEPTION
  59                WHEN STATUS_ERROR =>
  60                     NULL;
  61                WHEN OTHERS =>
  62                     FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER");
  63           END;
  64
  65           BEGIN
  66                GET (FILE => FILE1, ITEM => ST);
  67                FAILED ("STATUS_ERROR NOT RAISED - GET STRING");
  68           EXCEPTION
  69                WHEN STATUS_ERROR =>
  70                     NULL;
  71                WHEN OTHERS =>
  72                     FAILED ("WRONG EXCEPTION RAISED - GET STRING");
  73           END;
  74
  75           BEGIN
  76                GET_LINE (FILE => FILE1, ITEM => LN, LAST => LST);
  77                FAILED ("STATUS_ERROR NOT RAISED - GET_LINE");
  78           EXCEPTION
  79                WHEN STATUS_ERROR =>
  80                     NULL;
  81                WHEN OTHERS =>
  82                     FAILED ("WRONG EXCEPTION RAISED - GET_LINE");
  83           END;
  84
  85           BEGIN
  86                PUT (FILE => FILE1, ITEM => CH);
  87                FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER");
  88           EXCEPTION
  89                WHEN STATUS_ERROR =>
  90                     NULL;
  91                WHEN OTHERS =>
  92                     FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER");
  93           END;
  94
  95           BEGIN
  96                PUT (FILE => FILE1, ITEM => ST);
  97                FAILED ("STATUS_ERROR NOT RAISED - PUT STRING");
  98           EXCEPTION
  99                WHEN STATUS_ERROR =>
 100                     NULL;
 101                WHEN OTHERS =>
 102                     FAILED ("WRONG EXCEPTION RAISED - PUT STRING");
 103           END;
 104
 105           BEGIN
 106                PUT_LINE (FILE => FILE1, ITEM => LN);
 107                FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE");
 108           EXCEPTION
 109                WHEN STATUS_ERROR =>
 110                     NULL;
 111                WHEN OTHERS =>
 112                     FAILED ("WRONG EXCEPTION RAISED - PUT_LINE");
 113           END;
 114
 115           BEGIN
 116                CREATE (FILE2, OUT_FILE);   -- THIS IS ONLY AN ATTEMPT TO
 117                CLOSE (FILE2);              -- CREATE A FILE. OK, WHETHER
 118           EXCEPTION                        -- SUCCESSFUL OR NOT.
 119                WHEN USE_ERROR =>
 120                     NULL;
 121           END;
 122
 123           BEGIN
 124                GET (FILE => FILE2, ITEM => CH);
 125                FAILED ("STATUS_ERROR NOT RAISED - GET CHARACTER");
 126           EXCEPTION
 127                WHEN STATUS_ERROR =>
 128                     NULL;
 129                WHEN OTHERS =>
 130                     FAILED ("WRONG EXCEPTION RAISED - GET CHARACTER");
 131           END;
 132
 133           BEGIN
 134                GET (FILE => FILE2, ITEM => ST);
 135                FAILED ("STATUS_ERROR NOT RAISED - GET STRING");
 136           EXCEPTION
 137                WHEN STATUS_ERROR =>
 138                     NULL;
 139                WHEN OTHERS =>
 140                     FAILED ("WRONG EXCEPTION RAISED - GET STRING");
 141           END;
 142
 143           BEGIN
 144                GET_LINE (FILE => FILE2, ITEM => LN, LAST => LST);
 145                FAILED ("STATUS_ERROR NOT RAISED - GET_LINE");
 146           EXCEPTION
 147                WHEN STATUS_ERROR =>
 148                     NULL;
 149                WHEN OTHERS =>
 150                     FAILED ("WRONG EXCEPTION RAISED - GET_LINE");
 151           END;
 152
 153           BEGIN
 154                PUT (FILE => FILE2, ITEM => CH);
 155                FAILED ("STATUS_ERROR NOT RAISED - PUT CHARACTER");
 156           EXCEPTION
 157                WHEN STATUS_ERROR =>
 158                     NULL;
 159                WHEN OTHERS =>
 160                     FAILED ("WRONG EXCEPTION RAISED - PUT CHARACTER");
 161           END;
 162
 163           BEGIN
 164                PUT (FILE => FILE2, ITEM => ST);
 165                FAILED ("STATUS_ERROR NOT RAISED - PUT STRING");
 166           EXCEPTION
 167                WHEN STATUS_ERROR =>
 168                     NULL;
 169                WHEN OTHERS =>
 170                     FAILED ("WRONG EXCEPTION RAISED - PUT STRING");
 171           END;
 172
 173           BEGIN
 174                PUT_LINE (FILE => FILE2, ITEM => LN);
 175                FAILED ("STATUS_ERROR NOT RAISED - PUT_LINE");
 176           EXCEPTION
 177                WHEN STATUS_ERROR =>
 178                     NULL;
 179                WHEN OTHERS =>
 180                     FAILED ("WRONG EXCEPTION RAISED - PUT_LINE");
 181           END;
 182
 183      END;
 184
 185      RESULT;
 186
 187 END CE3601A;