Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c7/c74406a.ada @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
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 | |
33 WITH REPORT; USE REPORT; | |
34 | |
35 PROCEDURE 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 | |
128 BEGIN | |
129 NULL; | |
130 END C74406A; |