1-- CD3015E.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-- OBJECTIVE:
26--     CHECK THAT WHEN THERE IS NO ENUMERATION CLAUSE FOR THE PARENT
27--     TYPE IN A GENERIC UNIT, THE DERIVED TYPE CAN BE USED CORRECTLY
28--     IN ORDERING RELATIONS, INDEXING ARRAYS, AND IN GENERIC
29--     INSTANTIATIONS.
30
31-- HISTORY
32--     DHH 10/05/87 CREATED ORIGINAL TEST
33--     DHH 03/30/89 CHANGED EXTENSION FROM '.DEP' TO '.ADA' AND ADDED
34--                  CHECK FOR REPRESENTATION CLAUSE.
35--     RJW 03/20/90 MODIFIED CHECK FOR ARRAY INDEXING.
36--     THS 09/18/90 REVISED WORDING ON FAILURE ERROR MESSAGE.
37
38WITH REPORT; USE REPORT;
39WITH ENUM_CHECK;                        -- CONTAINS A CALL TO 'FAILED'.
40PROCEDURE CD3015E IS
41
42BEGIN
43
44     TEST ("CD3015E", "CHECK THAT WHEN THERE " &
45                      "IS NO ENUMERATION CLAUSE FOR THE PARENT " &
46                      "TYPE IN A GENERIC UNIT, THE " &
47                      "DERIVED TYPE CAN BE USED CORRECTLY IN " &
48                      "ORDERING RELATIONS, INDEXING ARRAYS, AND IN " &
49                      "GENERIC INSTANTIATIONS");
50
51     DECLARE
52
53          GENERIC
54          PACKAGE GENPACK IS
55
56               TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
57
58               TYPE HUE IS NEW MAIN;
59               FOR HUE USE
60                         (RED => 1, BLUE => 6,
61                               YELLOW => 11, 'R' => 16,
62                               'B' => 22, 'Y' => 30);
63
64               TYPE BASE IS ARRAY(HUE) OF INTEGER;
65               COLOR,BASIC : HUE;
66               BARRAY : BASE;
67               T : INTEGER := 1;
68
69               TYPE INT1 IS RANGE 1 .. 30;
70               FOR INT1'SIZE USE HUE'SIZE;
71
72               PROCEDURE CHECK_1 IS NEW ENUM_CHECK(HUE, INT1);
73
74               GENERIC
75                    TYPE ENUM IS (<>);
76               PROCEDURE CHANGE(X,Y : IN OUT ENUM);
77
78          END GENPACK;
79
80          PACKAGE BODY GENPACK IS
81
82               PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
83                    T : ENUM;
84               BEGIN
85                    T := X;
86                    X := Y;
87                    Y := T;
88               END CHANGE;
89
90               PROCEDURE PROC IS NEW CHANGE(HUE);
91
92          BEGIN
93               BASIC := RED;
94               COLOR := HUE'SUCC(BASIC);
95               IF (COLOR < BASIC OR
96                        BASIC >= 'R' OR
97                        'Y' <= COLOR OR
98                        COLOR > 'B') THEN
99                    FAILED("ORDERING RELATIONS ARE INCORRECT");
100               END IF;
101
102               PROC(BASIC,COLOR);
103
104               IF COLOR /= RED THEN
105                    FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
106                           "GENERIC UNIT NOT CORRECT AFTER CALL");
107               END IF;
108
109               FOR I IN HUE LOOP
110                    BARRAY(I) := IDENT_INT(T);
111                    T := T + 1;
112               END LOOP;
113
114               IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
115                   BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
116                   BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) THEN
117                    FAILED("INDEXING ARRAY FAILURE");
118               END IF;
119
120               CHECK_1 (YELLOW, 11, "HUE");
121
122          END GENPACK;
123
124          PACKAGE P IS NEW GENPACK;
125     BEGIN
126          NULL;
127     END;
128
129     RESULT;
130END CD3015E;
131