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
31WITH REPORT; USE REPORT;
32PROCEDURE  C49023A  IS
33
34BEGIN
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
117END C49023A;
118