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

   1 -- CE3804H.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 GET WHEN SUPPLIED WITH A WIDTH PARAMETER
  27 --     GREATER THAN ZERO READS ONLY THAT MANY CHARACTERS.  ALSO CHECK
  28 --     THAT INPUT TERMINATES WHEN A LINE TERMINATOR IS ENCOUNTERED AND
  29 --     THAT DATA_ERROR IS RAISED WHEN THE DATA IS INVALID.
  30
  31 -- APPLICABILITY CRITERIA:
  32 --     THIS TEST IS APPLICABLE ONLY TO IMPLEMENTATIONS WHICH
  33 --     SUPPORT TEXT FILES.
  34
  35 -- HISTORY:
  36 --     DWC 09/14/87  CREATED ORIGINAL TEST.
  37 --     RJW 08/17/89  CHANGED THE VALUE '-3.525' TO '-3.625'.
  38
  39 WITH REPORT;
  40 USE REPORT;
  41 WITH TEXT_IO;
  42 USE TEXT_IO;
  43
  44 PROCEDURE CE3804H IS
  45      INCOMPLETE : EXCEPTION;
  46
  47 BEGIN
  48
  49      TEST ("CE3804H", "CHECK THAT FIXED_IO GET WHEN SUPPLIED WITH " &
  50                       "A WIDTH PARAMETER GREATER THAN ZERO READS " &
  51                       "ONLY THAT MANY CHARACTERS.  ALSO CHECK THAT " &
  52                       "INPUT TERMINATES WHEN A LINE TERMINATOR IS " &
  53                       "ENCOUNTERED AND THAT DATA_ERROR IS RAISED " &
  54                       "WHEN THE DATA IS INVALID");
  55
  56      DECLARE
  57           FT : FILE_TYPE;
  58      BEGIN
  59
  60           BEGIN
  61                CREATE (FT, OUT_FILE, LEGAL_FILE_NAME);
  62           EXCEPTION
  63                WHEN USE_ERROR =>
  64                     NOT_APPLICABLE ("USE_ERROR RAISED; TEXT CREATE " &
  65                                     "WITH OUT_FILE MODE");
  66                     RAISE INCOMPLETE;
  67                WHEN NAME_ERROR =>
  68                     NOT_APPLICABLE ("NAME_ERROR RAISED; TEXT CREATE " &
  69                                     "WITH OUT_FILE MODE");
  70                     RAISE INCOMPLETE;
  71           END;
  72
  73           PUT(FT, "3.259.5 8.52");
  74           NEW_LINE (FT);
  75           PUT (FT, "  ");
  76           NEW_LINE (FT);
  77           PUT (FT, ASCII.HT & "9.0");
  78           NEW_LINE (FT);
  79           PUT (FT, "-3.625");
  80           NEW_LINE (FT);
  81
  82           CLOSE (FT);
  83
  84 -- BEGIN TEST
  85
  86           DECLARE
  87                TYPE FIXED IS DELTA 0.001 RANGE -100.0 .. 100.0;
  88                PACKAGE FX_IO IS NEW FIXED_IO (FIXED);
  89                USE FX_IO;
  90                X : FIXED;
  91
  92           BEGIN
  93                BEGIN
  94                     OPEN (FT, IN_FILE, LEGAL_FILE_NAME);
  95                EXCEPTION
  96                     WHEN USE_ERROR =>
  97                          NOT_APPLICABLE ("USE_ERROR RAISED; TEXT" &
  98                                          "OPEN WITH IN_FILE MODE");
  99                          RAISE INCOMPLETE;
 100                END;
 101
 102                GET (FT, X, 4);
 103                IF X /= 3.25 THEN
 104                     FAILED ("WIDTH CHARACTERS NOT READ - FIXED - 1");
 105                ELSE
 106                     GET (FT, X, 3);
 107                     IF X /= 9.5 THEN
 108                          FAILED ("WIDTH CHARACTERS NOT READ - " &
 109                                  "FIXED 2");
 110                     ELSE
 111                          GET (FT, X, 4);
 112                          IF X /= 8.5 THEN
 113                               FAILED ("DIDN'T COUNT LEADING BLANKS " &
 114                                       "- FIXED");
 115                          ELSE
 116                               SKIP_LINE(FT);
 117                               BEGIN
 118                                    GET (FT, X, 2);
 119                                    FAILED ("DATA_ERROR NOT RAISED - " &
 120                                            "FIXED");
 121                               EXCEPTION
 122                                    WHEN DATA_ERROR =>
 123                                         NULL;
 124                                    WHEN OTHERS =>
 125                                         FAILED ("WRONG EXCEPTION RAISED"
 126                                              & " - FIXED");
 127                               END;
 128
 129                               SKIP_LINE(FT);
 130                               GET (FT, X, 4);
 131                               IF X /= 9.0 THEN
 132                                    FAILED ("GET WITH WIDTH " &
 133                                            "INCORRECT");
 134                               END IF;
 135
 136                               SKIP_LINE (FT);
 137                               GET (FT, X, 7);
 138                               IF X /= -3.625 THEN
 139                                    FAILED ("WIDTH CHARACTERS NOT " &
 140                                            "READ");
 141                               END IF;
 142                          END IF;
 143                     END IF;
 144                END IF;
 145
 146                BEGIN
 147                    DELETE (FT);
 148                EXCEPTION
 149                    WHEN USE_ERROR =>
 150                         NULL;
 151                END;
 152           END;
 153
 154      EXCEPTION
 155           WHEN INCOMPLETE =>
 156                NULL;
 157      END;
 158
 159      RESULT;
 160
 161 END CE3804H;