Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cc/cc1226b.ada @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- CC1226B.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, FOR A FORMAL NONLIMITED PRIVATE TYPE, THAT ALL ALLOWABLE
27 -- OPERATIONS ARE IMPLICITLY DECLARED.
28
29 -- HISTORY:
30 -- BCB 04/04/88 CREATED ORIGINAL TEST.
31 -- RJW 03/28/90 INITIALIZED PREVIOUSLY UNINITIALIZED VARIABLES.
32 -- LDC 09/19/90 INITALIZED NLPVAR & NLPVAR2 TO DIFFERENT VALUES,
33 -- REMOVED USE CLAUSE.
34 -- PWN 01/31/95 REMOVED INCONSISTENCIES WITH ADA 9X.
35
36 WITH REPORT; USE REPORT;
37 WITH SYSTEM; USE SYSTEM;
38
39 PROCEDURE CC1226B IS
40
41 TYPE DISCREC(DISC1 : INTEGER := 1;
42 DISC2 : BOOLEAN := FALSE) IS RECORD
43 NULL;
44 END RECORD;
45
46 GENERIC
47 TYPE NLP IS PRIVATE;
48 TYPE NLPDISC(DISC1 : INTEGER;
49 DISC2 : BOOLEAN) IS PRIVATE;
50 WITH PROCEDURE INITIALIZE (N : OUT NLPDISC);
51 WITH FUNCTION INITIALIZE RETURN NLP;
52 WITH FUNCTION INITIALIZE_2 RETURN NLP;
53 PACKAGE P IS
54 FUNCTION IDENT(X : NLP) RETURN NLP;
55 FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS;
56 END P;
57
58 PACKAGE BODY P IS
59 TYPE DER_NLP IS NEW NLP;
60 NLPVAR : NLP := INITIALIZE_2;
61 NLPVAR2, NLPVAR3 : NLP := INITIALIZE;
62 DERNLP : DER_NLP := DER_NLP (INITIALIZE);
63 NDVAR : NLPDISC(DISC1 => 5, DISC2 => TRUE);
64 NLPVARADDRESS : ADDRESS;
65 NLPSIZE : INTEGER;
66 NLPBASESIZE : INTEGER;
67
68 FUNCTION IDENT(X : NLP) RETURN NLP IS
69 Z : NLP := INITIALIZE;
70 BEGIN
71 IF EQUAL(3,3) THEN
72 RETURN X;
73 END IF;
74 RETURN Z;
75 END IDENT;
76
77 FUNCTION IDENT_ADR(Y : ADDRESS) RETURN ADDRESS IS
78 I : INTEGER;
79 Z : ADDRESS := I'ADDRESS;
80 BEGIN
81 IF EQUAL(3,3) THEN
82 RETURN Y;
83 END IF;
84 RETURN Z;
85 END IDENT_ADR;
86
87 BEGIN
88 TEST ("CC1226B", "CHECK, FOR A FORMAL NONLIMITED PRIVATE " &
89 "TYPE THAT ALL ALLOWABLE OPERATIONS ARE " &
90 "IMPLICITLY DECLARED");
91
92 INITIALIZE (NDVAR);
93
94 NLPVAR := NLPVAR2;
95
96 IF NLPVAR /= NLPVAR2 THEN
97 FAILED ("IMPROPER VALUE FROM ASSIGNMENT");
98 END IF;
99
100 IF NLPVAR NOT IN NLP THEN
101 FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
102 END IF;
103
104 NLPVAR := NLP'(NLPVAR2);
105
106 IF NLPVAR /= NLPVAR2 THEN
107 FAILED ("IMPROPER RESULT FROM QUALIFICATION");
108 END IF;
109
110 NLPVAR := NLP(DERNLP);
111
112 IF NLPVAR /= IDENT(NLP(DERNLP)) THEN
113 FAILED ("IMPROPER RESULT FROM EXPLICIT CONVERSION");
114 END IF;
115
116 NLPSIZE := IDENT_INT(NLP'SIZE);
117
118 IF NLPSIZE /= INTEGER(NLP'SIZE) THEN
119 FAILED ("IMPROPER VALUE FOR NLP'SIZE");
120 END IF;
121
122 NLPVARADDRESS := NLPVAR'ADDRESS;
123
124 IF NLPVAR'ADDRESS /= IDENT_ADR(NLPVARADDRESS) THEN
125 FAILED ("IMPROPER VALUE FOR NLPVAR'ADDRESS");
126 END IF;
127
128 IF NDVAR.DISC1 /= IDENT_INT(5) THEN
129 FAILED ("IMPROPER DISCRIMINANT VALUE - 1");
130 END IF;
131
132 IF NOT NDVAR.DISC2 THEN
133 FAILED ("IMPROPER DISCRIMINANT VALUE - 2");
134 END IF;
135
136 IF NOT NDVAR'CONSTRAINED THEN
137 FAILED ("IMPROPER VALUE FOR NDVAR'CONSTRAINED");
138 END IF;
139
140 NLPVAR := NLPVAR3;
141
142 IF NOT (NLPVAR = IDENT(NLPVAR3)) THEN
143 FAILED ("IMPROPER VALUE FROM EQUALITY OPERATION");
144 END IF;
145
146 IF NLPVAR /= IDENT(NLPVAR3) THEN
147 FAILED ("IMPROPER VALUE FROM INEQUALITY OPERATION");
148 END IF;
149
150 RESULT;
151 END P;
152
153 PROCEDURE INITIALIZE (I : OUT DISCREC) IS
154 BEGIN
155 I := (5, TRUE);
156 END INITIALIZE;
157
158 FUNCTION INITIALIZE RETURN INTEGER IS
159 BEGIN
160 RETURN 5;
161 END INITIALIZE;
162
163 FUNCTION INITIALIZE_OTHER RETURN INTEGER IS
164 BEGIN
165 RETURN 3;
166 END INITIALIZE_OTHER;
167
168 PACKAGE PACK IS NEW P(INTEGER,
169 DISCREC,
170 INITIALIZE,
171 INITIALIZE,
172 INITIALIZE_OTHER);
173
174 BEGIN
175 NULL;
176 END CC1226B;