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