gcc/testsuite/ada/acats/tests/c4/c49023a.ada

   1 -- C49023A.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 A CONSTANT DECLARED BY AN OBJECT DECLARATION CAN BE USED
  26 -- IN A STATIC EXPRESSION IF THE CONSTANT WAS DECLARED WITH A STATIC
  27 -- SUBTYPE AND INITIALIZED WITH A STATIC EXPRESSION.
  28
  29 -- L.BROWN  10/01/86
  30
  31 WITH REPORT; USE REPORT;
  32 PROCEDURE  C49023A  IS
  33
  34 BEGIN
  35      TEST("C49023A","A CONSTANT DECLARED BY AN OBJECT DECLARATION "&
  36                     "UNDER CERTAIN CONDITIONS CAN BE USED IN A "&
  37                     "STATIC EXPRESSION");
  38      DECLARE
  39           TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
  40           SUBTYPE SENUM IS ENUM RANGE RED .. BLUE;
  41           CONEN : CONSTANT SENUM := GREEN;
  42           TYPE INT IS RANGE 1 .. 10;
  43           SUBTYPE SINT IS INT RANGE 1 .. 5;
  44           CONIN : CONSTANT SINT := 3;
  45           TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
  46           SUBTYPE SFLT IS FLT RANGE 10.0 .. 20.0;
  47           CONFL : CONSTANT SFLT := 11.0;
  48           TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 25.0;
  49           SUBTYPE SFIX IS FIX RANGE 0.0 .. 12.0;
  50           CONFI : CONSTANT SFIX := 0.25;
  51           CAS_EN : ENUM := CONEN;
  52           TYPE ITEG IS RANGE 1 .. CONIN;
  53           TYPE FLTY IS DIGITS CONIN;
  54           TYPE FIXY IS DELTA CONFI RANGE 0.0 .. 10.0;
  55           TYPE REAL IS DELTA 0.25 RANGE 0.0 .. 11.0;
  56           TYPE FIXTY IS DELTA 0.25 RANGE 0.0 .. CONFL;
  57
  58           FUNCTION IDENT_REAL (X : REAL) RETURN REAL;
  59
  60           PACKAGE P IS
  61                TYPE T IS PRIVATE;
  62                CON1 : CONSTANT T;
  63           PRIVATE
  64                TYPE T IS NEW INTEGER;
  65                CON1 : CONSTANT T := 10;
  66                TYPE NINT IS RANGE 1 .. CON1;
  67           END P;
  68           PACKAGE BODY P IS
  69                TYPE CON2 IS RANGE CON1 .. 50;
  70           BEGIN
  71                IF NINT'LAST /= NINT(IDENT_INT(10)) THEN
  72                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 1");
  73                END IF;
  74                IF CON2'FIRST /= CON2(IDENT_INT(10)) THEN
  75                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 2");
  76                END IF;
  77           END P;
  78
  79           FUNCTION IDENT_REAL (X : REAL) RETURN REAL IS
  80           BEGIN
  81                IF EQUAL(3,3) THEN
  82                     RETURN X;
  83                ELSE
  84                     RETURN 0.0;
  85                END IF;
  86           END IDENT_REAL;
  87
  88      BEGIN
  89
  90           IF ITEG'LAST /= ITEG(IDENT_INT(3))  THEN
  91                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 3");
  92           END IF;
  93
  94           IF FLTY'DIGITS /= IDENT_INT(3)  THEN
  95                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 4");
  96           END IF;
  97
  98           IF FIXY'DELTA /= IDENT_REAL(0.25)  THEN
  99                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 5");
 100           END IF;
 101
 102           IF FIXTY'LAST /= FIXTY(IDENT_REAL(11.0)) THEN
 103                FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 6");
 104           END IF;
 105
 106           CASE CAS_EN IS
 107                WHEN CONEN =>
 108                     CAS_EN := RED;
 109                WHEN OTHERS =>
 110                     FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 7");
 111           END CASE;
 112
 113      END;
 114
 115      RESULT;
 116
 117 END C49023A;