1-- C37211D.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 CONSTRAINT_ERROR IS RAISED BY A DISCRIMINANT CONSTRAINT
26-- IF A VALUE SPECIFIED FOR A DISCRIMINANT DOES NOT LIE IN THE RANGE
27-- OF THE DISCRIMINANT. THIS TEST CONTAINS CHECKS FOR SUBTYPE
28-- INDICATIONS WHERE THE TYPE MARK DENOTES AN INCOMPLETE TYPE.
29
30-- R.WILLIAMS 8/28/86
31-- EDS        7/14/98    AVOID OPTIMIZATION
32
33WITH REPORT; USE REPORT;
34PROCEDURE C37211D IS
35
36     GLOBAL : BOOLEAN;
37
38     TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
39
40     SUBTYPE WEEKDAY IS DAY RANGE MON .. FRI;
41
42     FUNCTION SWITCH (B : BOOLEAN) RETURN BOOLEAN IS
43     BEGIN
44          GLOBAL := B;
45          RETURN B;
46     END SWITCH;
47
48     FUNCTION IDENT (D : DAY) RETURN DAY IS
49     BEGIN
50          RETURN DAY'VAL (IDENT_INT (DAY'POS (D)));
51     END IDENT;
52
53BEGIN
54     TEST ( "C37211D", "CHECK THAT CONSTRAINT_ERROR IS RAISED BY " &
55                       "A DISCRIMINANT CONSTRAINT IF A VALUE " &
56                       "SPECIFIED FOR A DISCRIMINANT DOES NOT LIE " &
57                       "IN THE RANGE OF THE DISCRIMINANT WHERE THE " &
58                       "TYPE MARK DENOTES AN INCOMPLETE TYPE" );
59
60     BEGIN
61          DECLARE
62
63               B1 : BOOLEAN := SWITCH (TRUE);
64
65               TYPE REC (D : WEEKDAY);
66
67               TYPE ACCREC IS ACCESS REC (IDENT (SUN));
68
69               B2 : BOOLEAN := SWITCH (FALSE);
70
71               TYPE REC (D : WEEKDAY) IS
72                    RECORD
73                         NULL;
74                    END RECORD;
75          BEGIN
76               DECLARE
77                    AC : ACCREC;
78               BEGIN
79                    FAILED ( "NO EXCEPTION RAISED AT THE " &
80                             "ELABORATION OF TYPE ACCREC " & DAY'IMAGE(AC.D));
81               END;
82          EXCEPTION
83               WHEN OTHERS =>
84                    FAILED ( "EXCEPTION RAISED AT DECLARATION OF " &
85                             "OBJECT AC" );
86          END;
87
88     EXCEPTION
89          WHEN CONSTRAINT_ERROR =>
90               IF GLOBAL THEN
91                    NULL;
92               ELSE
93                    FAILED ( "EXCEPTION RAISED AT ELABORATION OF " &
94                             "FULL TYPE REC NOT TYPE ACCREC" );
95               END IF;
96          WHEN OTHERS =>
97               FAILED ( "WRONG EXCEPTION RAISED AT ELABORATION OF " &
98                        "TYPE ACCREC" );
99     END;
100
101     RESULT;
102END C37211D;
103