1-- C74406A.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 THE FULL DECLARATION OF A LIMITED PRIVATE TYPE CAN
27--     DECLARE A TASK TYPE, A TYPE DERIVED FROM A LIMITED PRIVATE TYPE,
28--     AND A COMPOSITE TYPE WITH A COMPONENT OF A LIMITED TYPE.
29
30-- HISTORY:
31--     BCB 03/10/88  CREATED ORIGINAL TEST.
32
33WITH REPORT; USE REPORT;
34
35PROCEDURE C74406A IS
36
37     PACKAGE TP IS
38          TYPE T IS LIMITED PRIVATE;
39          PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER);
40          FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN;
41     PRIVATE
42          TYPE T IS RANGE 1 .. 100;
43     END TP;
44
45     PACKAGE BODY TP IS
46          PROCEDURE INIT (Z1 : OUT T; Z2 : INTEGER) IS
47          BEGIN
48               Z1 := T (Z2);
49          END INIT;
50
51          FUNCTION EQUAL_T (ONE, TWO : T) RETURN BOOLEAN IS
52          BEGIN
53               IF EQUAL(3,3) THEN
54                    RETURN ONE = TWO;
55               ELSE
56                    RETURN ONE /= TWO;
57               END IF;
58          END EQUAL_T;
59     BEGIN
60          NULL;
61     END TP;
62
63     USE TP;
64
65     PACKAGE P IS
66          TYPE T1 IS LIMITED PRIVATE;
67          TYPE T2 IS LIMITED PRIVATE;
68          TYPE T3 IS LIMITED PRIVATE;
69          TYPE T4 IS LIMITED PRIVATE;
70     PRIVATE
71          TASK TYPE T1 IS
72               ENTRY HERE(VAL1 : IN OUT INTEGER);
73          END T1;
74
75          TYPE T2 IS NEW T;
76
77          TYPE T3 IS RECORD
78               INT : T;
79          END RECORD;
80
81          TYPE T4 IS ARRAY(1..5) OF T;
82     END P;
83
84     PACKAGE BODY P IS
85          X1 : T1;
86          X3 : T3;
87          X4 : T4;
88          VAR : INTEGER := 25;
89
90          TASK BODY T1 IS
91          BEGIN
92               ACCEPT HERE(VAL1 : IN OUT INTEGER) DO
93                    VAL1 := VAL1 * 2;
94               END HERE;
95          END T1;
96
97     BEGIN
98          TEST ("C74406A", "CHECK THAT THE FULL DECLARATION OF A " &
99                           "LIMITED PRIVATE TYPE CAN DECLARE A TASK " &
100                           "TYPE, A TYPE DERIVED FROM A LIMITED " &
101                           "PRIVATE TYPE, AND A COMPOSITE TYPE WITH " &
102                           "A COMPONENT OF A LIMITED TYPE");
103
104          X1.HERE(VAR);
105
106          IF NOT EQUAL(VAR,IDENT_INT(50)) THEN
107               FAILED ("IMPROPER VALUE FOR VAL");
108          END IF;
109
110          INIT (X3.INT, 50);
111
112          IF X3.INT NOT IN T THEN
113               FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
114          END IF;
115
116          INIT (X4(3), 17);
117
118          IF NOT EQUAL_T(T'(X4(3)),T(X4(3))) THEN
119               FAILED ("IMPROPER RESULT FROM QUALIFICATION AND " &
120                       "EXPLICIT CONVERSION");
121          END IF;
122
123          RESULT;
124     END P;
125
126     USE P;
127
128BEGIN
129     NULL;
130END C74406A;
131