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

   1 -- CE2401A.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 (WITH AND WITHOUT PARAMETER FROM), WRITE (WITH
  27 --     AND WITHOUT PARAMETER TO), SET_INDEX, INDEX, SIZE AND
  28 --     END_OF_FILE ARE SUPPORTED FOR DIRECT FILES WITH ELEMENT_TYPES
  29 --     STRING, CHARACTER, AND INTEGER.
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS ONLY APPLICABLE TO IMPLEMENTATIONS WHICH
  33 --     SUPPORT DIRECT FILES.
  34
  35 -- HISTORY:
  36 --     ABW 08/16/82
  37 --     SPS 09/15/82
  38 --     SPS 11/09/82
  39 --     JBG 02/22/84  CHANGE TO .ADA TEST.
  40 --     EG  05/16/85
  41 --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  42 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  43 --     DWC 07/31/87  ISOLATED EXCEPTIONS.
  44
  45 WITH REPORT; USE REPORT;
  46 WITH DIRECT_IO;
  47
  48 PROCEDURE CE2401A IS
  49      END_SUBTEST : EXCEPTION;
  50 BEGIN
  51
  52      TEST ("CE2401A" , "CHECK THAT READ, WRITE, SET_INDEX " &
  53                        "INDEX, SIZE AND END_OF_FILE ARE " &
  54                        "SUPPORTED FOR DIRECT FILES");
  55
  56      DECLARE
  57           SUBTYPE STR_TYPE IS STRING (1..12);
  58           PACKAGE DIR_STR IS NEW DIRECT_IO (STR_TYPE);
  59           USE DIR_STR;
  60           FILE_STR : FILE_TYPE;
  61      BEGIN
  62           BEGIN
  63                CREATE (FILE_STR, INOUT_FILE, LEGAL_FILE_NAME);
  64           EXCEPTION
  65                WHEN USE_ERROR | NAME_ERROR =>
  66                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
  67                                     "ON CREATE - STRING");
  68                     RAISE END_SUBTEST;
  69                WHEN OTHERS =>
  70                     FAILED ("UNEXPECTED ERROR RAISED ON " &
  71                             "CREATE - STRING");
  72                     RAISE END_SUBTEST;
  73           END;
  74
  75           DECLARE
  76                STR : STR_TYPE := "TEXT OF FILE";
  77                ITEM_STR : STR_TYPE;
  78                ONE_STR : POSITIVE_COUNT := 1;
  79                TWO_STR : POSITIVE_COUNT := 2;
  80           BEGIN
  81                BEGIN
  82                     WRITE (FILE_STR,STR);
  83                EXCEPTION
  84                     WHEN OTHERS =>
  85                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
  86                                  "STRING - 1");
  87                END;
  88
  89                BEGIN
  90                     WRITE (FILE_STR,STR,TWO_STR);
  91                EXCEPTION
  92                     WHEN OTHERS =>
  93                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
  94                                  "STRING - 2");
  95                END;
  96
  97                BEGIN
  98                     IF SIZE (FILE_STR) /= TWO_STR THEN
  99                          FAILED ("SIZE FOR TYPE STRING");
 100                     END IF;
 101                     IF NOT END_OF_FILE (FILE_STR) THEN
 102                          FAILED ("WRONG END_OF_FILE VALUE FOR STRING");
 103                     END IF;
 104                     SET_INDEX (FILE_STR,ONE_STR);
 105                     IF INDEX (FILE_STR) /= ONE_STR THEN
 106                          FAILED ("WRONG INDEX VALUE FOR STRING");
 107                     END IF;
 108                END;
 109
 110                CLOSE (FILE_STR);
 111
 112                BEGIN
 113                     OPEN (FILE_STR, IN_FILE, LEGAL_FILE_NAME);
 114                EXCEPTION
 115                     WHEN USE_ERROR =>
 116                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
 117                                          "NOT SUPPORTED - 1");
 118                          RAISE END_SUBTEST;
 119                END;
 120
 121                BEGIN
 122                     READ (FILE_STR,ITEM_STR);
 123                     IF ITEM_STR /= STR THEN
 124                          FAILED ("INCORRECT STRING VALUE READ - 1");
 125                     END IF;
 126                EXCEPTION
 127                     WHEN OTHERS =>
 128                          FAILED ("READ WITHOUT FROM FOR STRING");
 129                END;
 130
 131                BEGIN
 132                     READ (FILE_STR,ITEM_STR,ONE_STR);
 133                     IF ITEM_STR /= STR THEN
 134                          FAILED ("INCORRECT STRING VALUE READ - 2");
 135                     END IF;
 136                EXCEPTION
 137                     WHEN OTHERS =>
 138                          FAILED ("READ WITH FROM FOR STRING");
 139                END;
 140           END;
 141
 142           BEGIN
 143                DELETE (FILE_STR);
 144           EXCEPTION
 145                WHEN USE_ERROR =>
 146                     NULL;
 147           END;
 148
 149      EXCEPTION
 150           WHEN END_SUBTEST =>
 151                NULL;
 152      END;
 153
 154      DECLARE
 155           PACKAGE DIR_CHR IS NEW DIRECT_IO (CHARACTER);
 156           USE DIR_CHR;
 157           FILE_CHR : FILE_TYPE;
 158      BEGIN
 159           BEGIN
 160                CREATE (FILE_CHR, INOUT_FILE, LEGAL_FILE_NAME(2));
 161           EXCEPTION
 162                WHEN USE_ERROR | NAME_ERROR =>
 163                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
 164                                     "ON CREATE - CHARACTER");
 165                     RAISE END_SUBTEST;
 166                WHEN OTHERS =>
 167                     FAILED ("UNEXPECTED ERROR RAISED ON " &
 168                             "CREATE - CHARACTER");
 169                     RAISE END_SUBTEST;
 170           END;
 171
 172           DECLARE
 173                CHR : CHARACTER := 'C';
 174                ITEM_CHR : CHARACTER;
 175                ONE_CHR : POSITIVE_COUNT := 1;
 176                TWO_CHR : POSITIVE_COUNT := 2;
 177           BEGIN
 178                BEGIN
 179                     WRITE (FILE_CHR,CHR);
 180                EXCEPTION
 181                     WHEN OTHERS =>
 182                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
 183                                  "CHARACTER - 1");
 184                END;
 185
 186                BEGIN
 187                     WRITE (FILE_CHR,CHR,TWO_CHR);
 188                EXCEPTION
 189                     WHEN OTHERS =>
 190                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
 191                                  "CHARACTER - 2");
 192                END;
 193
 194                BEGIN
 195                     IF SIZE (FILE_CHR) /= TWO_CHR THEN
 196                          FAILED ("SIZE FOR TYPE CHARACTER");
 197                     END IF;
 198                     IF NOT END_OF_FILE (FILE_CHR) THEN
 199                          FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
 200                                  "CHARACTER");
 201                     END IF;
 202                     SET_INDEX (FILE_CHR,ONE_CHR);
 203                     IF INDEX (FILE_CHR) /= ONE_CHR THEN
 204                          FAILED ("WRONG INDEX VALUE FOR TYPE " &
 205                                  "CHARACTER");
 206                     END IF;
 207                END;
 208
 209                CLOSE (FILE_CHR);
 210
 211                BEGIN
 212                     OPEN (FILE_CHR, IN_FILE, LEGAL_FILE_NAME(2));
 213                EXCEPTION
 214                     WHEN USE_ERROR =>
 215                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
 216                                          "NOT SUPPORTED - 2");
 217                          RAISE END_SUBTEST;
 218                END;
 219
 220                BEGIN
 221                     READ (FILE_CHR,ITEM_CHR);
 222                     IF ITEM_CHR /= CHR THEN
 223                          FAILED ("INCORRECT CHR VALUE READ - 1");
 224                     END IF;
 225                EXCEPTION
 226                     WHEN OTHERS =>
 227                          FAILED ("READ WITHOUT FROM FOR " &
 228                                  "TYPE CHARACTER");
 229                END;
 230
 231                BEGIN
 232                     READ (FILE_CHR,ITEM_CHR,ONE_CHR);
 233                     IF ITEM_CHR /= CHR THEN
 234                          FAILED ("INCORRECT CHR VALUE READ - 2");
 235                     END IF;
 236                EXCEPTION
 237                     WHEN OTHERS =>
 238                          FAILED ("READ WITH FROM FOR " &
 239                                  "TYPE CHARACTER");
 240                END;
 241           END;
 242
 243           BEGIN
 244                DELETE (FILE_CHR);
 245           EXCEPTION
 246                WHEN USE_ERROR =>
 247                     NULL;
 248           END;
 249
 250      EXCEPTION
 251           WHEN END_SUBTEST =>
 252                NULL;
 253      END;
 254
 255      DECLARE
 256           PACKAGE DIR_INT IS NEW DIRECT_IO (INTEGER);
 257           USE DIR_INT;
 258           FILE_INT : FILE_TYPE;
 259      BEGIN
 260           BEGIN
 261                CREATE (FILE_INT, INOUT_FILE, LEGAL_FILE_NAME(3));
 262           EXCEPTION
 263                WHEN USE_ERROR | NAME_ERROR =>
 264                     NOT_APPLICABLE ("USE_ERROR | NAME_ERROR RAISED " &
 265                                     "ON CREATE - INTEGER");
 266                     RAISE END_SUBTEST;
 267                WHEN OTHERS =>
 268                     FAILED ("UNEXPECTED ERROR RAISED ON " &
 269                             "CREATE - INTEGER");
 270                     RAISE END_SUBTEST;
 271           END;
 272
 273           DECLARE
 274                INT : INTEGER := IDENT_INT (33);
 275                ITEM_INT : INTEGER;
 276                ONE_INT : POSITIVE_COUNT := 1;
 277                TWO_INT : POSITIVE_COUNT := 2;
 278           BEGIN
 279                BEGIN
 280                     WRITE (FILE_INT,INT);
 281                EXCEPTION
 282                     WHEN OTHERS =>
 283                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
 284                                  "INTEGER - 1");
 285                END;
 286
 287                BEGIN
 288                     WRITE (FILE_INT,INT,TWO_INT);
 289                EXCEPTION
 290                     WHEN OTHERS =>
 291                          FAILED ("EXCEPTION RAISED ON WRITE FOR " &
 292                                  "INTEGER - 2");
 293                END;
 294
 295                BEGIN
 296                     IF SIZE (FILE_INT) /= TWO_INT THEN
 297                          FAILED ("SIZE FOR TYPE INTEGER");
 298                     END IF;
 299                     IF NOT END_OF_FILE (FILE_INT) THEN
 300                          FAILED ("WRONG END_OF_FILE VALUE FOR TYPE " &
 301                                  "INTEGER");
 302                     END IF;
 303                     SET_INDEX (FILE_INT, ONE_INT);
 304                     IF INDEX (FILE_INT) /= ONE_INT THEN
 305                          FAILED ("WRONG INDEX VALUE FOR TYPE INTEGER");
 306                     END IF;
 307                END;
 308
 309                CLOSE (FILE_INT);
 310
 311                BEGIN
 312                     OPEN (FILE_INT, IN_FILE, LEGAL_FILE_NAME(3));
 313                EXCEPTION
 314                     WHEN USE_ERROR =>
 315                          NOT_APPLICABLE ("OPEN FOR IN_FILE MODE " &
 316                                          "NOT SUPPORTED - 3");
 317                          RAISE END_SUBTEST;
 318                END;
 319
 320                BEGIN
 321                     READ (FILE_INT,ITEM_INT);
 322                     IF ITEM_INT /= INT THEN
 323                          FAILED ("INCORRECT INT VALUE READ - 1");
 324                     END IF;
 325                EXCEPTION
 326                     WHEN OTHERS =>
 327                          FAILED ("READ WITHOUT FROM FOR " &
 328                                  "TYPE INTEGER");
 329                END;
 330
 331                BEGIN
 332                     READ (FILE_INT,ITEM_INT,ONE_INT);
 333                     IF ITEM_INT /= INT THEN
 334                          FAILED ("INCORRECT INT VALUE READ - 2");
 335                     END IF;
 336                EXCEPTION
 337                     WHEN OTHERS =>
 338                          FAILED ("READ WITH FROM FOR " &
 339                                  "TYPE INTEGER");
 340                END;
 341           END;
 342
 343           BEGIN
 344                DELETE (FILE_INT);
 345           EXCEPTION
 346                WHEN USE_ERROR =>
 347                     NULL;
 348           END;
 349
 350      EXCEPTION
 351           WHEN END_SUBTEST =>
 352                NULL;
 353      END;
 354
 355      RESULT;
 356
 357 END CE2401A;