gcc/testsuite/ada/acats/tests/c3/c35904b.ada

   1 -- C35904B.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 -- CHECK THAT INCOMPATIBLE FIXED POINT CONSTRAINTS RAISE
  26 -- CONSTRAINT_ERROR FOR GENERIC FORMAL TYPES.
  27
  28 -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
  29 -- ***       remove incompatibilities associated with the transition   -- 9X
  30 -- ***       to Ada 9X.                                                -- 9X
  31
  32 -- RJW 6/20/86
  33 -- DWC 07/24/87     -- ADDED NUMERIC_ERROR HANDLERS.
  34 -- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
  35 -- EDS 07/16/98 AVOID OPTIMIZATION
  36
  37 WITH REPORT; USE REPORT;
  38 PROCEDURE C35904B IS
  39
  40      GENERIC
  41           TYPE FIX IS DELTA <>;
  42      PROCEDURE PROC (STR : STRING);
  43
  44      PROCEDURE PROC (STR : STRING) IS
  45           SUBTYPE SFIX IS FIX DELTA 0.1 RANGE -1.0 .. 1.0;
  46           -- DEFINE AN OBJECT OF SUBTYPE SFIX AND USE IT TO AVOID
  47           -- OPTIMIZATION OF SUBTYPE
  48           SFIX_VAR : SFIX := SFIX(IDENT_INT(0));
  49      BEGIN
  50           FAILED ("NO EXCEPTION RAISED FOR " & STR & " " &
  51                   SFIX'IMAGE(SFIX_VAR) );  --USE SFIX_VAR
  52      END PROC;
  53
  54 BEGIN
  55
  56      TEST ( "C35904B", "CHECK THAT INCOMPATIBLE FIXED POINT " &
  57                        "CONSTRAINTS RAISE CONSTRAINT_ERROR " &
  58                        "FOR GENERIC FORMAL TYPES" );
  59
  60 -- TEST FOR INCORRECT SUBTYPE DEFINITION ON ACCURACY BETWEEN TYPE AND
  61 -- SUBTYPE DEFINITIONS.
  62
  63      BEGIN
  64
  65           DECLARE
  66
  67                TYPE FIX1 IS DELTA 0.5          -- DELTA IS SMALLER FOR
  68                          RANGE -2.0 .. 2.0;    -- SUBTYPE THEN FOR
  69                                                -- TYPE.
  70
  71                PROCEDURE NPROC IS NEW PROC (FIX1);
  72
  73           BEGIN
  74                NPROC ( "INCOMPATIBLE DELTA" );
  75           END;
  76
  77      EXCEPTION
  78           WHEN CONSTRAINT_ERROR =>
  79                NULL;
  80           WHEN OTHERS =>
  81                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
  82                        "DELTA CONSTRAINT");
  83      END;
  84
  85 -- TEST THAT CONSTRAINT_ERROR IS RAISED
  86 -- FOR A RANGE VIOLATION.
  87
  88      BEGIN
  89
  90           DECLARE
  91
  92                TYPE FIX2 IS DELTA 0.1 RANGE 0.0 .. 2.0; -- LOWER
  93                                                         -- BOUND.
  94
  95                PROCEDURE NPROC IS NEW PROC (FIX2);
  96
  97           BEGIN
  98                NPROC ("FIXED POINT LOWER BOUND CONSTRAINT VIOLATION");
  99           END;
 100
 101      EXCEPTION
 102           WHEN CONSTRAINT_ERROR =>
 103                COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
 104                         "LOWER BOUND VIOLATION");
 105           WHEN OTHERS =>
 106                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
 107                        "FIXED POINT LOWER BOUND CONSTRAINT");
 108      END;
 109
 110 -- TEST THAT CONSTRAINT_ERROR IS RAISED
 111 -- FOR A RANGE VIOLATION.
 112
 113      BEGIN
 114
 115           DECLARE
 116
 117                TYPE FIX3 IS DELTA 0.1 RANGE -2.0 .. 0.0;  -- UPPER
 118                                                           -- BOUND.
 119
 120                PROCEDURE NPROC IS NEW PROC (FIX3);
 121           BEGIN
 122                NPROC ("FIXED POINT UPPER BOUND CONSTRAINT VIOLATION");
 123           END;
 124
 125      EXCEPTION
 126           WHEN CONSTRAINT_ERROR =>
 127                COMMENT ("CONSTRAINT_ERROR RAISED FOR " &
 128                         "UPPER BOUND VIOLATION");
 129           WHEN OTHERS =>
 130                FAILED ("INCORRECT EXCEPTION RAISED WHILE CHECKING " &
 131                        "FIXED POINT UPPER BOUND CONSTRAINT");
 132      END;
 133
 134      RESULT;
 135
 136 END C35904B;