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

   1 -- CE3806H.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 FIXED_IO PUT RAISES LAYOUT_ERROR WHEN THE NUMBER OF
  27 --     CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.  CHECK
  28 --     THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED, WHEN THE
  29 --     NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO THE CURRENT
  30 --     COLUMN NUMBER, THE TOTAL EXCEEDS THE MAX.
  31
  32 -- APPLICABILITY CRITERIA:
  33 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH SUPPORT
  34 --     TEXT FILES.
  35
  36 -- HISTORY:
  37 --     JLH 09/15/87  CREATED ORIGINAL TEST.
  38
  39 WITH REPORT; USE REPORT;
  40 WITH TEXT_IO; USE TEXT_IO;
  41 WITH CHECK_FILE;
  42
  43 PROCEDURE CE3806H IS
  44
  45 BEGIN
  46
  47      TEST ("CE3806H", "CHECK THAT FIXED_IO PUT RAISES " &
  48                       "LAYOUT_ERROR CORRECTLY");
  49
  50      DECLARE
  51           FT : FILE_TYPE;
  52           TYPE FX IS DELTA 0.01 RANGE -200.0 .. 200.0;
  53           PACKAGE FXIO IS NEW FIXED_IO (FX);
  54           USE FXIO;
  55           INCOMPLETE : EXCEPTION;
  56           X : FX := 126.5;
  57           Y : FX := -134.0;
  58           Z : FX := 120.0;
  59
  60      BEGIN
  61
  62           BEGIN
  63                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
  64           EXCEPTION
  65                WHEN USE_ERROR =>
  66                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
  67                                     "WITH OUT_FILE MODE");
  68                     RAISE INCOMPLETE;
  69                WHEN NAME_ERROR =>
  70                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
  71                                     "CREATE WITH OUT_FILE MODE");
  72                     RAISE INCOMPLETE;
  73           END;
  74
  75           SET_LINE_LENGTH (FT, 4);
  76
  77           BEGIN
  78                PUT (FT, X, FORE => 3, AFT => 1);
  79                FAILED ("LAYOUT_ERROR NOT RAISED - FIXED");
  80           EXCEPTION
  81                WHEN LAYOUT_ERROR =>
  82                     NULL;
  83                WHEN OTHERS =>
  84                     FAILED ("WRONG EXCEPTION RAISED - FIXED");
  85           END;
  86
  87           SET_LINE_LENGTH (FT,7);
  88
  89           BEGIN
  90                PUT (FT, Y, FORE => 3, AFT => 2);
  91           EXCEPTION
  92                WHEN LAYOUT_ERROR =>
  93                     FAILED ("LAYOUT_ERROR RAISED SECOND PUT - " &
  94                             "FIXED");
  95                WHEN OTHERS =>
  96                     FAILED ("SOME EXCEPTION RAISED SECOND PUT - " &
  97                             "FIXED");
  98           END;
  99
 100           BEGIN
 101                PUT (FT,Z, FORE => 4, AFT => 2);
 102                IF LINE (FT) /= 2 THEN
 103                     FAILED ("NEW_LINE NOT CALLED - FIXED");
 104                END IF;
 105           EXCEPTION
 106                WHEN LAYOUT_ERROR =>
 107                     FAILED ("LAYOUT_ERROR RAISED THIRD PUT - " &
 108                             "FIXED");
 109                WHEN OTHERS =>
 110                     FAILED ("EXCEPTION RAISED THIRD PUT - FIXED");
 111           END;
 112
 113           BEGIN
 114                PUT (FT, "Y");
 115                PUT (FT, Z, FORE => 3, AFT => 0);
 116                NEW_LINE (FT);
 117                PUT (FT, "Z");
 118                PUT (FT, Y, FORE => 3, AFT => 2);
 119           EXCEPTION
 120                WHEN LAYOUT_ERROR =>
 121                     FAILED ("LAYOUT_ERROR RAISED LAST PUT - " &
 122                             "FIXED");
 123                WHEN OTHERS =>
 124                     FAILED ("EXCEPTION RAISED LAST PUT - FIXED ");
 125           END;
 126
 127           CHECK_FILE (FT, "-134.00# 120.00#Y120.0#Z#-134.00#@%");
 128
 129           BEGIN
 130                DELETE (FT);
 131           EXCEPTION
 132                WHEN USE_ERROR =>
 133                     NULL;
 134           END;
 135
 136      EXCEPTION
 137           WHEN INCOMPLETE =>
 138                NULL;
 139
 140      END;
 141
 142      RESULT;
 143
 144 END CE3806H;