Dead
[official-gcc.git] / gomp-20050608-branch / gcc / testsuite / ada / acats / tests / cc / cc3240a.ada
blob1983b94294f4aeabe61afb1b536fb4b2a3ba3e53
1 -- CC3240A.ADA
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.
16 -- DISCLAIMER
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 FORMAL PRIVATE AND LIMITED PRIVATE TYPE DENOTES ITS
27 -- ACTUAL PARAMETER, AND OPERATIONS OF THE FORMAL TYPE ARE
28 -- IDENTIFIED WITH CORRESPONDING OPERATIONS OF THE ACTUAL TYPE
29 -- WHEN THE FORMAL TYPE IS A TYPE WITH DISCRIMINANTS.
31 -- HISTORY:
32 -- RJW 10/13/88 CREATED ORIGINAL TEST.
34 WITH REPORT; USE REPORT;
35 PROCEDURE CC3240A IS
37 BEGIN
38 TEST ("CC3240A", "CHECK THAT A FORMAL PRIVATE OR LIMITED " &
39 "PRIVATE TYPE DENOTES ITS ACTUAL PARAMETER AND " &
40 "OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED " &
41 "WITH CORRESPONDING OPERATIONS OF THE ACTUAL " &
42 "TYPE, WHEN THE FORMAL TYPE IS A TYPE " &
43 "WITH DISCRIMINANTS");
45 DECLARE
47 GENERIC
48 TYPE T(A : INTEGER) IS PRIVATE;
49 PACKAGE P IS
50 SUBTYPE S IS T;
51 TX : T(5);
52 END P;
54 TYPE REC (L : INTEGER) IS
55 RECORD
56 A : INTEGER;
57 END RECORD;
59 PACKAGE P1 IS NEW P (REC);
60 USE P1;
62 BEGIN
63 TX := (L => 5, A => 7);
64 IF NOT (TX IN REC) THEN
65 FAILED ("MEMBERSHIP TEST - PRIVATE");
66 END IF;
68 IF TX.A /= 7 OR TX.L /= 5 THEN
69 FAILED ("SELECTED COMPONENTS - PRIVATE");
70 END IF;
72 IF S(TX) /= REC(TX) THEN
73 FAILED ("EXPLICIT CONVERSION - PRIVATE");
74 END IF;
76 IF NOT TX'CONSTRAINED THEN
77 FAILED ("'CONSTRAINED - PRIVATE");
78 END IF;
79 END;
81 DECLARE
82 TYPE REC(L : INTEGER) IS
83 RECORD
84 A : INTEGER;
85 END RECORD;
87 GENERIC
88 TYPE T(A : INTEGER) IS LIMITED PRIVATE;
89 TX : IN OUT T;
90 PACKAGE LP IS
91 SUBTYPE S IS T;
92 END LP;
94 R : REC (5) := (5, 7);
96 PACKAGE BODY LP IS
97 BEGIN
98 IF (TX IN S) /= (R IN REC) THEN
99 FAILED ("MEMBERSHIP TEST - LIMITED PRIVATE");
100 END IF;
102 IF TX.A /= 5 THEN
103 FAILED ("SELECTED COMPONENTS - LIMITED PRIVATE");
104 END IF;
106 IF (S(TX) IN S) /= (REC(R) IN REC) THEN
107 FAILED ("EXPLICIT CONVERSION - LIMITED PRIVATE");
108 END IF;
110 IF NOT TX'CONSTRAINED THEN
111 FAILED ("'CONSTRAINED - LIMITED PRIVATE");
112 END IF;
113 END LP;
115 PACKAGE P1 IS NEW LP (REC, R);
116 USE P1;
117 BEGIN
118 NULL;
119 END;
121 RESULT;
122 END CC3240A;