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

   1 -- CE3815A.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 THE OPERATIONS IN GENERIC PACKAGE FLOAT_IO ALL HAVE
  27 --     THE CORRECT PARAMETER NAMES.
  28
  29 -- HISTORY:
  30 --     JET 10/28/88  CREATED ORIGINAL TEST.
  31
  32 WITH REPORT; USE REPORT;
  33 WITH TEXT_IO; USE TEXT_IO;
  34 PROCEDURE CE3815A IS
  35
  36      STR : STRING(1..20) := (OTHERS => ' ');
  37      FIN, FOUT : FILE_TYPE;
  38      F : FLOAT;
  39      L : POSITIVE;
  40      FILE_OK : BOOLEAN := FALSE;
  41
  42      PACKAGE FIO IS NEW FLOAT_IO(FLOAT);
  43      USE FIO;
  44
  45 BEGIN
  46      TEST ("CE3815A", "CHECK THAT THE OPERATIONS IN GENERIC PACKAGE " &
  47                       "FLOAT_IO ALL HAVE THE CORRECT PARAMETER NAMES");
  48
  49      PUT (TO => STR, ITEM => 1.0, AFT => 3, EXP => 3);
  50      GET (FROM => STR, ITEM => F, LAST => L);
  51
  52      BEGIN
  53           CREATE(FOUT, OUT_FILE, LEGAL_FILE_NAME);
  54           FILE_OK := TRUE;
  55      EXCEPTION
  56           WHEN OTHERS =>
  57                COMMENT("OUTPUT FILE COULD NOT BE CREATED");
  58      END;
  59
  60      IF FILE_OK THEN
  61           BEGIN
  62                PUT (FILE => FOUT, ITEM => 1.0, FORE => 3, AFT => 3,
  63                     EXP => 3);
  64                NEW_LINE(FOUT);
  65
  66                CLOSE(FOUT);
  67           EXCEPTION
  68                WHEN OTHERS =>
  69                     FAILED("OUTPUT FILE COULD NOT BE WRITTEN");
  70                     FILE_OK := FALSE;
  71           END;
  72      END IF;
  73
  74      IF FILE_OK THEN
  75           BEGIN
  76                OPEN(FIN, IN_FILE, LEGAL_FILE_NAME);
  77           EXCEPTION
  78                WHEN OTHERS =>
  79                     FAILED("INPUT FILE COULD NOT BE OPENED");
  80                     FILE_OK := FALSE;
  81           END;
  82      END IF;
  83
  84      IF FILE_OK THEN
  85           BEGIN
  86                GET (FILE => FIN, ITEM => F, WIDTH => 10);
  87           EXCEPTION
  88                WHEN OTHERS =>
  89                     FAILED ("DATA COULD NOT BE READ FROM FILE");
  90           END;
  91
  92           BEGIN
  93                DELETE(FIN);
  94           EXCEPTION
  95                WHEN USE_ERROR =>
  96                     COMMENT("FILE COULD NOT BE DELETED");
  97                WHEN OTHERS =>
  98                     FAILED("UNEXPECTED ERROR AT DELETION");
  99           END;
 100      END IF;
 101
 102      RESULT;
 103 END CE3815A;