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

   1 -- CE3304A.TST
   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 BY A CALL TO SET_LINE_LENGTH
  27 --     OR TO SET_PAGE_LENGTH WHEN THE SPECIFIED VALUE IS INAPPROPRIATE
  28 --     FOR THE EXTERNAL FILE.
  29
  30 -- APPLICABILITY CRITERIA:
  31 --     THIS TEST IS APPLICABLE TO IMPLEMENTATIONS THAT SATISFY THE
  32 --     FOLLOWING CONDITIONS:
  33 --       1) TEXT FILES ARE SUPPORTED
  34 --       2) EITHER BY DEFAULT OR BY USE OF THE "FORM" PARAMETER TO
  35 --          THE CREATE PROCEDURE, A TEXT FILE CAN BE CREATED FOR
  36 --          WHICH AT LEAST ONE OF THE FOLLOWING CONDITIONS HOLDS:
  37 --           A)  THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
  38 --               AN APPROPRIATE LINE-LENGTH FOR THE FILE,
  39 --             OR
  40 --           B)  THERE IS A VALUE OF TYPE TEXT_IO.COUNT THAT IS NOT
  41 --               AN APPROPRIATE PAGE-LENGTH FOR THE FILE.
  42
  43 -- MACRO SUBSTITUTIONS:
  44 --     FOR THE MACRO SYMBOL "$FORM_STRING," SUBSTITUTE A STRING LITERAL
  45 --     SPECIFIYING THAT THE EXTERNAL FILE MEETS BOTH OF THE CONDITIONS
  46 --     (A) AND (B) ABOVE.  IF IT IS NOT POSSIBLE TO SATISFY BOTH
  47 --     CONDITIONS, THEN SUBSTITUTE A STRING LITERAL SPECIFYING THAT THE
  48 --     EXTERNAL FILE SATISFIES ONE OF THE CONDITIONS.  IF IT IS NOT
  49 --     POSSIBLE TO SATISFY EITHER CONDITION, THEN SUBSTITUE THE NULL
  50 --     STRING ("").
  51 --     FOR THE MACRO SYMBOL "$INAPPROPRIATE_LINE_LENGTH," SUBSTITUTE
  52 --     A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE LINE-LENGTH
  53 --     FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
  54 --     FOR THE MACRO SYMBOL "$INAPPROPRIATE_PAGE_LENGTH," SUBSTITUTE
  55 --     A LITERAL OF TYPE COUNT THAT IS INAPPROPRIATE AS THE PAGE-LENGTH
  56 --     FOR THE EXTERNAL FILE.  IF THERE IS NO SUCH VALUE, THEN USE -1.
  57
  58 -- HISTORY:
  59 --     PWB 07/07/88  CREATED ORIGINAL TEST.
  60
  61 WITH REPORT; USE REPORT;
  62 WITH TEXT_IO; USE TEXT_IO;
  63
  64 PROCEDURE CE3304A IS
  65
  66      FILE1,
  67      FILE2,
  68      FILE3 : FILE_TYPE;
  69
  70      LINE_LENGTH_SHOULD_WORK,
  71      PAGE_LENGTH_SHOULD_WORK : BOOLEAN;
  72
  73      INCOMPLETE : EXCEPTION;
  74
  75      TEST_VALUE : COUNT;
  76
  77 BEGIN
  78
  79      TEST ("CE3304A", "CHECK THAT USE_ERROR IS RAISED IF A CALL TO " &
  80                       "SET_LINE_LENGTH OR SET_PAGE_LENGTH SPECIFIES " &
  81                       "A VALUE THAT IS INAPPROPRIATE FOR THE " &
  82                       "EXTERNAL FILE");
  83
  84      BEGIN     -- CHECK WHETHER TEXT FILES ARE SUPPORTED.
  85
  86           CREATE(FILE1, OUT_FILE, LEGAL_FILE_NAME(1),
  87                  FORM => $FORM_STRING);
  88           PUT_LINE(FILE1, "AAA");
  89           CLOSE(FILE1);
  90
  91      EXCEPTION
  92
  93           WHEN USE_ERROR | NAME_ERROR =>
  94                NOT_APPLICABLE ("CREATION OF TEXT FILES NOT SUPPORTED");
  95                RAISE INCOMPLETE;
  96           WHEN OTHERS =>
  97                FAILED ("WRONG EXCEPTION RAISED AT INITIAL CREATE");
  98                RAISE INCOMPLETE;
  99      END;
 100
 101      BEGIN  -- CHECK INAPPROPRIATE LINE LENGTH.
 102
 103           BEGIN   -- IS THERE AN INAPPROPRIATE VALUE?
 104                TEST_VALUE :=
 105                          COUNT(IDENT_INT($INAPPROPRIATE_LINE_LENGTH));
 106                IF NOT EQUAL (INTEGER(TEST_VALUE),
 107                              INTEGER(TEST_VALUE)) THEN
 108                     COMMENT ("OPTIMIZATION DEFEATED" &
 109                               COUNT'IMAGE(TEST_VALUE));
 110                END IF;
 111                LINE_LENGTH_SHOULD_WORK := TRUE;
 112           EXCEPTION
 113                WHEN CONSTRAINT_ERROR =>
 114                     LINE_LENGTH_SHOULD_WORK := FALSE;
 115                     COMMENT("THERE IS NO INAPPROPRIATE LINE LENGTH");
 116           END;
 117
 118           IF LINE_LENGTH_SHOULD_WORK THEN
 119                BEGIN
 120                     CREATE(FILE2, OUT_FILE, LEGAL_FILE_NAME(2),
 121                            FORM => $FORM_STRING);
 122                     SET_LINE_LENGTH(FILE2, $INAPPROPRIATE_LINE_LENGTH);
 123                     FAILED("NO EXCEPTION FOR INAPPROPRIATE LINE " &
 124                            "LENGTH");
 125                EXCEPTION
 126                     WHEN USE_ERROR =>
 127                          IF NOT IS_OPEN(FILE2) THEN
 128                               FAILED ("FILE NOT OPENED -- LINE LENGTH");
 129                          END IF;
 130                     WHEN OTHERS =>
 131                          FAILED ("WRONG EXCEPTION RAISED FOR " &
 132                                  "INAPPROPRIATE LINE LENGTH");
 133                END;
 134           END IF;
 135      END;
 136
 137 -----------------------------------------------------------------------
 138
 139      BEGIN  -- CHECK INAPPROPRIATE PAGE LENGTH.
 140
 141           BEGIN   -- IS THERE AN INAPPROPRIATE VALUE?
 142                TEST_VALUE :=
 143                          COUNT(IDENT_INT($INAPPROPRIATE_PAGE_LENGTH));
 144                IF NOT EQUAL (INTEGER(TEST_VALUE),
 145                              INTEGER(TEST_VALUE)) THEN
 146                     COMMENT ("OPTIMIZATION DEFEATED" &
 147                              COUNT'IMAGE(TEST_VALUE));
 148                END IF;
 149                PAGE_LENGTH_SHOULD_WORK := TRUE;
 150           EXCEPTION
 151                WHEN CONSTRAINT_ERROR =>
 152                     PAGE_LENGTH_SHOULD_WORK := FALSE;
 153                     COMMENT("THERE IS NO INAPPROPRIATE PAGE LENGTH");
 154           END;
 155
 156           IF PAGE_LENGTH_SHOULD_WORK THEN
 157                BEGIN
 158                     CREATE(FILE3, OUT_FILE, LEGAL_FILE_NAME(3),
 159                            FORM => $FORM_STRING);
 160                     SET_PAGE_LENGTH(FILE3, $INAPPROPRIATE_PAGE_LENGTH);
 161                     FAILED("NO EXCEPTION FOR INAPPROPRIATE PAGE " &
 162                            "LENGTH");
 163                EXCEPTION
 164                     WHEN USE_ERROR =>
 165                          IF NOT IS_OPEN(FILE3) THEN
 166                               FAILED ("FILE NOT OPENED -- PAGE LENGTH");
 167                          END IF;
 168                     WHEN OTHERS =>
 169                          FAILED ("WRONG EXCEPTION RAISED FOR " &
 170                                  "INAPPROPRIATE PAGE LENGTH");
 171                END;
 172           END IF;
 173      END;
 174
 175      IF NOT (PAGE_LENGTH_SHOULD_WORK OR LINE_LENGTH_SHOULD_WORK) THEN
 176           NOT_APPLICABLE("NO INAPPROPRIATE VALUES FOR EITHER LINE " &
 177                          "LENGTH OR PAGE LENGTH");
 178      END IF;
 179
 180      BEGIN     -- CLEAN UP FILES.
 181
 182           IF IS_OPEN(FILE1) THEN
 183                CLOSE(FILE1);
 184           END IF;
 185
 186           IF IS_OPEN(FILE2) THEN
 187                CLOSE(FILE2);
 188           END IF;
 189
 190           IF IS_OPEN(FILE3) THEN
 191                CLOSE(FILE3);
 192           END IF;
 193
 194      EXCEPTION
 195           WHEN USE_ERROR =>
 196                COMMENT("FILES NOT DELETED");
 197      END;
 198
 199      RESULT;
 200
 201 EXCEPTION
 202      WHEN INCOMPLETE =>
 203           RESULT;
 204 END CE3304A;