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

   1 -- CE2406A.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 --     FOR A DIRECT ACCESS FILE, CHECK THAT AFTER A READ, THE CURRENT
  27 --     READ POSITION IS INCREMENTED BY ONE.
  28
  29 -- APPLICABILITY CRITERIA:
  30 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  31 --     DIRECT_IO FILES.
  32
  33 -- HISTORY:
  34 --     ABW 08/20/82
  35 --     SPS 09/16/82
  36 --     SPS 11/09/82
  37 --     JBG 02/22/84  CHANGE TO .ADA TEST.
  38 --     EG  05/16/85
  39 --     TBN 11/04/86  REVISED TEST TO OUTPUT A NON_APPLICABLE
  40 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  41 --     GMT 08/05/87  REMOVED DEPENDENCE ON RESET AND ADDED CHECK FOR
  42 --                   USE_ERROR ON DELETE.
  43
  44 WITH REPORT; USE REPORT;
  45 WITH DIRECT_IO;
  46
  47 PROCEDURE CE2406A IS
  48
  49      PACKAGE DIR IS NEW DIRECT_IO (INTEGER);
  50      USE DIR;
  51      FILE1                : FILE_TYPE;
  52      INT                  : INTEGER := IDENT_INT (18);
  53      BOOL                 : BOOLEAN := IDENT_BOOL (TRUE);
  54      INT_ITEM1, INT_ITEM2 : INTEGER;
  55      INCOMPLETE           : EXCEPTION;
  56
  57 BEGIN
  58
  59      TEST ("CE2406A", "CHECK THAT READ POSITION IS INCREMENTED " &
  60                       "BY ONE AFTER A READ");
  61
  62      -- CREATE AND INITIALIZE FILE1
  63
  64      BEGIN
  65
  66           BEGIN
  67                CREATE (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
  68           EXCEPTION
  69                WHEN NAME_ERROR | USE_ERROR =>
  70                     NOT_APPLICABLE ("NAME_ERROR | USE_ERROR RAISED " &
  71                                     "ON CREATE - 1");
  72                     RAISE INCOMPLETE;
  73                WHEN OTHERS =>
  74                     FAILED ("WRONG EXCEPTION RAISED ON CREATE - 2");
  75                     RAISE INCOMPLETE;
  76           END;
  77
  78           BEGIN
  79                WRITE (FILE1, INT);
  80                WRITE (FILE1, 26);
  81                WRITE (FILE1, 12);
  82                WRITE (FILE1, 19);
  83                WRITE (FILE1, INT);
  84                WRITE (FILE1, 3);
  85
  86                -- BEGIN TEST
  87
  88                CLOSE (FILE1);
  89                BEGIN
  90                     OPEN (FILE1, IN_FILE, LEGAL_FILE_NAME);
  91                EXCEPTION
  92                     WHEN USE_ERROR =>
  93                          NOT_APPLICABLE ("USE_ERROR RAISED ON" &
  94                                          "OPEN - 3");
  95                          RAISE INCOMPLETE;
  96                     WHEN OTHERS =>
  97                          FAILED ("WRONG EXCEPTION RAISED ON " &
  98                                          "OPEN - 4");
  99                          RAISE INCOMPLETE;
 100                END;
 101
 102
 103                IF INDEX(FILE1) /= POSITIVE_COUNT (IDENT_INT(1)) THEN
 104                     FAILED ("INITIAL INDEX VALUE INCORRECT - 5");
 105                ELSE
 106                     READ (FILE1, INT_ITEM1);
 107                     IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
 108                          FAILED ("INDEX VALUE NOT INCREMENTED - 6");
 109                     ELSE
 110                          IF INT_ITEM1 /= IDENT_INT(18) THEN
 111                               FAILED ("READ INCORRECT VALUE - 7");
 112                          END IF;
 113                          READ (FILE1, INT_ITEM1, 4);
 114                          IF INDEX(FILE1) /=
 115                             POSITIVE_COUNT (IDENT_INT(5)) THEN
 116                              FAILED ("INDEX VALUE NOT INCREMENTED " &
 117                                      "WHEN TO IS SPECIFIED - 8");
 118                          ELSE
 119                               IF INT_ITEM1 /= IDENT_INT(19) THEN
 120                                    FAILED ("READ INCORRECT VALUE - 9");
 121                               END IF;
 122                               READ (FILE1, INT_ITEM1);
 123                               IF INDEX(FILE1) /=
 124                                  POSITIVE_COUNT(IDENT_INT(6)) THEN
 125                                    FAILED ("INDEX VALUE NOT " &
 126                                            "INCREMENTED WHEN " &
 127                                            "LAST - 10");
 128                               ELSIF INT_ITEM1 /= IDENT_INT(18) THEN
 129                                    FAILED ("READ INCORRECT " &
 130                                            "IN_FILE VALUE - 11");
 131                               END IF;
 132                          END IF;
 133                     END IF;
 134                END IF;
 135
 136                CLOSE (FILE1);
 137                BEGIN
 138                     OPEN (FILE1, INOUT_FILE, LEGAL_FILE_NAME);
 139                EXCEPTION
 140                     WHEN USE_ERROR =>
 141                          NOT_APPLICABLE ("USE_ERROR RAISED ON " &
 142                                          "OPEN - 12");
 143                          RAISE INCOMPLETE;
 144                     WHEN OTHERS =>
 145                          FAILED ("WRONG EXCEPTION RAISED ON " &
 146                                          "OPEN - 13");
 147                          RAISE INCOMPLETE;
 148                END;
 149
 150                IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(1)) THEN
 151                     FAILED ("INITIAL INDEX VALUE INCORRECT - 14");
 152                ELSE
 153                     READ (FILE1, INT_ITEM2);
 154                     IF INDEX(FILE1) /= POSITIVE_COUNT(IDENT_INT(2)) THEN
 155                          FAILED ("INDEX VALUE NOT INCREMENTED - 15");
 156                     ELSE
 157                          IF INT_ITEM2 /= IDENT_INT(18) THEN
 158                               FAILED ("READ INCORRECT VALUE - 16");
 159                          END IF;
 160                          READ (FILE1, INT_ITEM2, 4);
 161                          IF INDEX (FILE1) /=
 162                             POSITIVE_COUNT(IDENT_INT(5)) THEN
 163                              FAILED ("INDEX VALUE NOT INCREMENTED " &
 164                                      "WHEN TO IS SPECIFIED - 17");
 165                          ELSE
 166                               IF INT_ITEM2 /= IDENT_INT(19) THEN
 167                                    FAILED ("INCORRECT VALUE - 18");
 168                               END IF;
 169                               READ (FILE1, INT_ITEM2);
 170                               IF INDEX(FILE1) /=
 171                                  POSITIVE_COUNT(IDENT_INT(6)) THEN
 172                                    FAILED ("INDEX VALUE NOT " &
 173                                            "INCREMENTED WHEN " &
 174                                            "LAST - INOUT_FILE - 19");
 175                               ELSIF INT_ITEM2 /= IDENT_INT(18) THEN
 176                                    FAILED ("READ INCORRECT " &
 177                                            "INOUT_FILE VALUE - 20");
 178                               END IF;
 179                          END IF;
 180                     END IF;
 181                END IF;
 182
 183                BEGIN
 184                     DELETE (FILE1);
 185                EXCEPTION
 186                     WHEN USE_ERROR =>
 187                          NULL;
 188                END;
 189
 190           END;
 191
 192      EXCEPTION
 193           WHEN INCOMPLETE =>
 194                NULL;
 195      END;
 196
 197      RESULT;
 198
 199 END CE2406A;