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

   1 -- CE3806E.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 FLOAT_IO PUT RAISE LAYOUT_ERROR WHEN THE NUMBER
  27 --     OF CHARACTERS TO BE OUTPUT EXCEEDS THE MAXIMUM LINE LENGTH.
  28 --     CHECK THAT IT IS NOT RAISED, BUT RATHER NEW_LINE IS CALLED,
  29 --     WHEN THE NUMBER DOES NOT EXCEED THE MAX, BUT WHEN ADDED TO
  30 --     THE CURRENT 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 --     SPS 10/07/82
  38 --     SPS 12/14/82
  39 --     VKG 01/13/83
  40 --     SPS 02/18/83
  41 --     JBG 08/30/83
  42 --     RJW 11/04/86  REVISED TEST TO OUTPUT A NOT_APPLICABLE
  43 --                   RESULT WHEN FILES ARE NOT SUPPORTED.
  44 --     JLH 09/14/87  REMOVED DEPENDENCE ON RESET AND CORRECTED
  45 --                   EXCEPTION HANDLING.
  46
  47 WITH REPORT;
  48 USE REPORT;
  49 WITH TEXT_IO;
  50 USE TEXT_IO;
  51 WITH CHECK_FILE;
  52
  53 PROCEDURE CE3806E IS
  54
  55 BEGIN
  56
  57      TEST ("CE3806E", "CHECK THAT FLOAT_IO PUT RAISES " &
  58                       "LAYOUT_ERROR CORRECTLY");
  59
  60      DECLARE
  61           TYPE FL IS DIGITS 3 RANGE 100.0 .. 200.0;
  62           PACKAGE FLIO IS NEW FLOAT_IO (FL);
  63           USE FLIO;
  64           X : FL := 126.0;
  65           Y : FL := 134.0;
  66           Z : FL := 120.0;
  67           INCOMPLETE : EXCEPTION;
  68           FT : FILE_TYPE;
  69      BEGIN
  70
  71           BEGIN
  72                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
  73           EXCEPTION
  74                WHEN USE_ERROR =>
  75                     NOT_APPLICABLE ("USE_ERROR RAISED ON TEXT CREATE " &
  76                                     "WITH OUT_FILE MODE");
  77                     RAISE INCOMPLETE;
  78                WHEN NAME_ERROR =>
  79                     NOT_APPLICABLE ("NAME_ERROR RAISED ON TEXT " &
  80                                     "CREATE WITH OUT_FILE MODE");
  81                     RAISE INCOMPLETE;
  82           END;
  83
  84           SET_LINE_LENGTH (FT, 8);
  85
  86           BEGIN
  87                PUT (FT, X);        -- " 1.26E+02"
  88                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT");
  89           EXCEPTION
  90                WHEN LAYOUT_ERROR =>
  91                     NULL;
  92                WHEN OTHERS =>
  93                     FAILED ("WRONG EXCEPTION RAISED - FLOAT");
  94
  95           END;
  96
  97           BEGIN
  98                PUT (FT, Y, FORE => 1); -- "1.34E+02"
  99           EXCEPTION
 100                WHEN LAYOUT_ERROR =>
 101                     FAILED ("LAYOUT_ERROR RAISED SECOND PUT " &
 102                             "- FLOAT");
 103                WHEN OTHERS =>
 104                     FAILED ("EXCEPTION RAISED SECOND PUT - FLOAT");
 105           END;
 106
 107           BEGIN
 108                PUT (FT,Z, FORE => 1, AFT => 0); -- "1.2E+02"
 109                IF LINE (FT) /= 2 THEN
 110                     FAILED ("NEW_LINE NOT CALLED - FLOAT");
 111                END IF;
 112           EXCEPTION
 113                WHEN LAYOUT_ERROR =>
 114                     FAILED ("LAYOUT_ERROR RAISED THIRD " &
 115                             "PUT - FLOAT");
 116                WHEN OTHERS =>
 117                     FAILED ("EXCEPTION RAISED THIRD PUT - FLOAT");
 118           END;
 119
 120           SET_LINE_LENGTH ( FT,7);
 121
 122           BEGIN
 123                PUT (FT, "X");
 124                PUT (FT, Y, FORE => 1, AFT => 2,
 125                     EXP => 1);          -- 1.34E+2
 126           EXCEPTION
 127                WHEN LAYOUT_ERROR =>
 128                     FAILED ("LAYOUT_ERROR RAISED - 3 FLOAT");
 129           END;
 130
 131           BEGIN
 132                PUT (FT, "Z");
 133                PUT (FT, Z, FORE => 1);
 134                FAILED ("LAYOUT_ERROR NOT RAISED - FLOAT 2");
 135           EXCEPTION
 136                WHEN LAYOUT_ERROR =>
 137                     NULL;
 138                WHEN OTHERS =>
 139                     FAILED ("SOME EXCEPTION RAISED - 3 FLOAT");
 140           END;
 141
 142           CHECK_FILE (FT, "1.34E+02#1.2E+02#X#1.34E+2#Z#@%");
 143
 144           BEGIN
 145                DELETE (FT);
 146           EXCEPTION
 147                WHEN USE_ERROR =>
 148                     NULL;
 149           END;
 150
 151      EXCEPTION
 152           WHEN INCOMPLETE =>
 153                NULL;
 154
 155      END;
 156
 157      RESULT;
 158
 159 END CE3806E;