gcc/testsuite/ada/acats/tests/c3/c35503f.tst

   1 -- C35503F.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 'IMAGE' AND 'VALUE' YIELD THE CORRECT RESULT FOR THE
  27 --     LARGEST/SMALLEST INTEGER LITERAL AND A FORMAL DISCRETE TYPE WHOSE
  28 --     ACTUAL PARAMETER IS AN INTEGER TYPE.
  29
  30 -- HISTORY
  31 --     RJW 05/12/86 CREATED ORIGINAL TEST.
  32 --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
  33
  34 WITH SYSTEM; USE SYSTEM;
  35 WITH REPORT; USE REPORT;
  36
  37 PROCEDURE C35503F IS
  38
  39 TYPE LONGEST_INT IS RANGE MIN_INT .. MAX_INT;
  40
  41 BEGIN
  42      TEST ("C35503F", "CHECK THAT 'IMAGE' AND 'VALUE' YIELD " &
  43                       "CORRECT RESULTS FOR THE LARGEST/SMALLEST "&
  44                       "INTEGER LITERAL AND A FORMAL DISCRETE TYPE " &
  45                       "WHOSE ACTUAL PARAMETER IS AN INTEGER TYPE");
  46
  47      -- INTEGER_FIRST IS THE DECIMAL LITERAL IMAGE OF INTEGER'FIRST.
  48      -- INTEGER_LAST IS THE DECIMAL LITERAL IMAGE OF INTEGER'LAST.
  49      -- MIN_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MIN_INT.
  50      -- MAX_INT IS THE DECIMAL LITERAL IMAGE OF SYSTEM.MAX_INT.
  51
  52      DECLARE
  53           GENERIC
  54                TYPE INT IS (<>);
  55           PROCEDURE P ( FS, LS : STRING; FI, LI : INT );
  56
  57           PROCEDURE P ( FS, LS : STRING; FI, LI : INT ) IS
  58           BEGIN
  59                BEGIN
  60                     IF INT'VALUE (FS) /= FI THEN
  61                          FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
  62                                   FS );
  63                     END IF;
  64                EXCEPTION
  65                      WHEN CONSTRAINT_ERROR =>
  66                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
  67                                   "'VALUE' OF " & FS );
  68                      WHEN OTHERS =>
  69                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
  70                                   "'VALUE' OF " & FS );
  71                END;
  72
  73                BEGIN
  74                     IF INT'VALUE (LS) /= LI THEN
  75                          FAILED ( "INCORRECT RESULTS FOR 'VALUE' OF " &
  76                                   LS );
  77                     END IF;
  78                EXCEPTION
  79                      WHEN CONSTRAINT_ERROR =>
  80                          FAILED ( "CONSTRAINT_ERROR RAISED FOR " &
  81                                   "'VALUE' OF " & LS );
  82                      WHEN OTHERS =>
  83                          FAILED ( "OTHER EXCEPTION RAISED FOR " &
  84                                   "'VALUE' OF " & LS );
  85                END;
  86           END P;
  87
  88           GENERIC
  89                TYPE INT IS  (<>);
  90           PROCEDURE Q ( FS, LS : STRING; FI, LI : INT );
  91
  92           PROCEDURE Q ( FS, LS : STRING; FI, LI : INT ) IS
  93           BEGIN
  94                BEGIN
  95                      IF INT'IMAGE(FI) /= FS THEN
  96                           FAILED ( "INCORRECT RESULTS FOR " &
  97                                    "'IMAGE' WITH " & FS );
  98                      END IF;
  99                EXCEPTION
 100                     WHEN OTHERS =>
 101                          FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
 102                                    "WITH " & FS );
 103                END;
 104
 105                BEGIN
 106                      IF INT'IMAGE(LI) /= LS THEN
 107                          FAILED ( "INCORRECT RESULTS FOR " &
 108                                   "'IMAGE' WITH " & LS );
 109                      END IF;
 110                EXCEPTION
 111                     WHEN OTHERS =>
 112                          FAILED ( "EXCEPTION RAISED FOR 'IMAGE' " &
 113                                   "WITH " & LS );
 114                END;
 115           END Q;
 116
 117           PROCEDURE P1 IS NEW P ( INTEGER );
 118           PROCEDURE Q1 IS NEW Q ( INTEGER );
 119           PROCEDURE P2 IS NEW P ( LONGEST_INT );
 120           PROCEDURE Q2 IS NEW Q ( LONGEST_INT );
 121      BEGIN
 122           P1 ("$INTEGER_FIRST", "$INTEGER_LAST", INTEGER'FIRST,
 123                                                          INTEGER'LAST);
 124           P2 ("$MIN_INT", "$MAX_INT", MIN_INT, MAX_INT);
 125           Q1 ("$INTEGER_FIRST"," $INTEGER_LAST", INTEGER'FIRST,
 126                                                          INTEGER'LAST);
 127           Q2 ("$MIN_INT", " $MAX_INT", MIN_INT, MAX_INT);
 128
 129      END;
 130
 131      RESULT;
 132 END C35503F;