1-- C37310A.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 IF A DISCRIMINANT HAS A DYNAMIC SUBTYPE, AN OTHERS
26-- CHOICE CAN BE OMITTED IF ALL VALUES IN THE BASE
27-- TYPE'S RANGE ARE COVERED.
28
29-- ASL 7/10/81
30-- SPS 10/25/82
31-- PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
32
33WITH REPORT;
34PROCEDURE C37310A IS
35
36     USE REPORT;
37
38BEGIN
39     TEST ("C37310A", "CHECK DYNAMIC DISCRIMINANT SUBTYPES " &
40                      "IN VARIANT RECORD DECLARATIONS");
41
42     DECLARE
43
44          ACHAR : CHARACTER := IDENT_CHAR('A');
45          ECHAR : CHARACTER := IDENT_CHAR('E');
46          JCHAR : CHARACTER := IDENT_CHAR('J');
47          MCHAR : CHARACTER := IDENT_CHAR('M');
48          SUBTYPE STATCHAR IS CHARACTER RANGE 'I'..'N';
49          SUBTYPE DYNCHAR IS CHARACTER RANGE ACHAR..ECHAR;
50          SUBTYPE SSTAT IS STATCHAR RANGE JCHAR..MCHAR;
51
52          TYPE LETTER IS NEW CHARACTER RANGE 'A'..'Z';
53          SUBTYPE DYNLETTER IS
54               LETTER RANGE LETTER(ECHAR)..LETTER(JCHAR);
55
56          TYPE REC1(DISC : SSTAT := 'K') IS
57               RECORD
58                    CASE DISC IS
59                         WHEN ASCII.NUL..CHARACTER'LAST => NULL;
60                    END CASE;
61               END RECORD;
62
63          TYPE REC2(DISC : DYNCHAR := 'C') IS
64               RECORD
65                    CASE DISC IS
66                         WHEN ASCII.NUL..CHARACTER'LAST => NULL;
67                    END CASE;
68               END RECORD;
69
70          TYPE REC3(DISC: DYNCHAR := 'D') IS
71               RECORD
72                    CASE DISC IS
73                         WHEN CHARACTER'FIRST..CHARACTER'LAST => NULL;
74                    END CASE;
75               END RECORD;
76
77          TYPE REC4(DISC : DYNLETTER := 'F') IS
78               RECORD
79                    CASE DISC IS
80                         WHEN LETTER'BASE'FIRST..
81                              LETTER'BASE'LAST => NULL;
82                    END CASE;
83               END RECORD;
84
85          R1 : REC1;
86          R2 : REC2;
87          R3 : REC3;
88          R4 : REC4;
89     BEGIN
90          IF EQUAL(3,3) THEN
91               R1 := (DISC => 'L');
92          END IF;
93          IF R1.DISC /= 'L' THEN
94               FAILED ("ASSIGNMENT FAILED - 1");
95          END IF;
96
97          IF EQUAL(3,3) THEN
98              R2 := (DISC => 'B');
99          END IF;
100          IF R2.DISC /= 'B' THEN
101               FAILED ("ASSIGNMENT FAILED - 2");
102          END IF;
103
104          IF EQUAL(3,3) THEN
105               R3 := (DISC => 'B');
106          END IF;
107          IF R3.DISC /= 'B' THEN
108               FAILED ("ASSIGNMENT FAILED - 3");
109          END IF;
110
111          IF EQUAL(3,3) THEN
112               R4 := (DISC => 'H');
113          END IF;
114          IF R4.DISC /= 'H' THEN
115               FAILED ("ASSIGNMENT FAILED - 4");
116          END IF;
117     EXCEPTION
118          WHEN OTHERS =>
119              FAILED ("EXCEPTION RAISED");
120     END;
121
122     RESULT;
123
124END C37310A;
125