Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/cd/cd10002.a @ 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 -- CD10002.A | |
2 -- | |
3 -- Grant of Unlimited Rights | |
4 -- | |
5 -- The Ada Conformity Assessment Authority (ACAA) holds unlimited | |
6 -- rights in the software and documentation contained herein. Unlimited | |
7 -- rights are the same as those granted by the U.S. Government for older | |
8 -- parts of the Ada Conformity Assessment Test Suite, and are defined | |
9 -- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA | |
10 -- intends to confer upon all recipients unlimited rights equal to those | |
11 -- held by the ACAA. These rights include rights to use, duplicate, | |
12 -- release or disclose the released technical data and computer software | |
13 -- in whole or in part, in any manner and for any purpose whatsoever, and | |
14 -- to have or permit others 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 -- | |
26 -- OBJECTIVE: | |
27 -- Check that operational items are allowed in some contexts where | |
28 -- representation items are not: | |
29 -- | |
30 -- 1 - Check that the name of an incompletely defined type can be used | |
31 -- when specifying an operational item. (RM95/TC1 7.3(5)). | |
32 -- | |
33 -- 2 - Check that operational items can be specified for a descendant of | |
34 -- a generic formal untagged type. (RM95/TC1 13.1(10)). | |
35 -- | |
36 -- 3 - Check that operational items can be specified for a derived | |
37 -- untagged type even if the parent type is a by-reference type or | |
38 -- has user-defined primitive subprograms. (RM95/TC1 13.1(11/1)). | |
39 -- | |
40 -- (Defect Report 8652/0009, as reflected in Technical Corrigendum 1). | |
41 -- | |
42 -- CHANGE HISTORY: | |
43 -- 19 JAN 2001 PHL Initial version. | |
44 -- 3 DEC 2001 RLB Reformatted for ACATS. | |
45 -- 3 OCT 2002 RLB Corrected incorrect type derivations. | |
46 -- | |
47 --! | |
48 with Ada.Streams; | |
49 use Ada.Streams; | |
50 package CD10002_0 is | |
51 | |
52 type Kinds is (Read, Write, Input, Output); | |
53 type Counts is array (Kinds) of Natural; | |
54 | |
55 generic | |
56 type T is private; | |
57 package Nonlimited_Stream_Ops is | |
58 | |
59 procedure Write (Stream : access Root_Stream_Type'Class; Item : T); | |
60 function Input (Stream : access Root_Stream_Type'Class) return T; | |
61 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T); | |
62 procedure Output (Stream : access Root_Stream_Type'Class; Item : T); | |
63 | |
64 function Get_Counts return Counts; | |
65 | |
66 end Nonlimited_Stream_Ops; | |
67 | |
68 generic | |
69 type T (<>) is limited private; -- Should be self-initializing. | |
70 C : in out T; | |
71 package Limited_Stream_Ops is | |
72 | |
73 procedure Write (Stream : access Root_Stream_Type'Class; Item : T); | |
74 function Input (Stream : access Root_Stream_Type'Class) return T; | |
75 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T); | |
76 procedure Output (Stream : access Root_Stream_Type'Class; Item : T); | |
77 | |
78 function Get_Counts return Counts; | |
79 | |
80 end Limited_Stream_Ops; | |
81 | |
82 end CD10002_0; | |
83 | |
84 | |
85 package body CD10002_0 is | |
86 | |
87 package body Nonlimited_Stream_Ops is | |
88 Cnts : Counts := (others => 0); | |
89 X : T; -- Initialized by Write/Output. | |
90 | |
91 procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is | |
92 begin | |
93 X := Item; | |
94 Cnts (Write) := Cnts (Write) + 1; | |
95 end Write; | |
96 | |
97 function Input (Stream : access Root_Stream_Type'Class) return T is | |
98 begin | |
99 Cnts (Input) := Cnts (Input) + 1; | |
100 return X; | |
101 end Input; | |
102 | |
103 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is | |
104 begin | |
105 Cnts (Read) := Cnts (Read) + 1; | |
106 Item := X; | |
107 end Read; | |
108 | |
109 procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is | |
110 begin | |
111 X := Item; | |
112 Cnts (Output) := Cnts (Output) + 1; | |
113 end Output; | |
114 | |
115 function Get_Counts return Counts is | |
116 begin | |
117 return Cnts; | |
118 end Get_Counts; | |
119 | |
120 end Nonlimited_Stream_Ops; | |
121 | |
122 package body Limited_Stream_Ops is | |
123 Cnts : Counts := (others => 0); | |
124 | |
125 procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is | |
126 begin | |
127 Cnts (Write) := Cnts (Write) + 1; | |
128 end Write; | |
129 | |
130 function Input (Stream : access Root_Stream_Type'Class) return T is | |
131 begin | |
132 Cnts (Input) := Cnts (Input) + 1; | |
133 return C; | |
134 end Input; | |
135 | |
136 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is | |
137 begin | |
138 Cnts (Read) := Cnts (Read) + 1; | |
139 end Read; | |
140 | |
141 procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is | |
142 begin | |
143 Cnts (Output) := Cnts (Output) + 1; | |
144 end Output; | |
145 | |
146 function Get_Counts return Counts is | |
147 begin | |
148 return Cnts; | |
149 end Get_Counts; | |
150 | |
151 end Limited_Stream_Ops; | |
152 | |
153 end CD10002_0; | |
154 | |
155 | |
156 with Ada.Streams; | |
157 use Ada.Streams; | |
158 package CD10002_1 is | |
159 | |
160 type Dummy_Stream is new Root_Stream_Type with null record; | |
161 procedure Read (Stream : in out Dummy_Stream; | |
162 Item : out Stream_Element_Array; | |
163 Last : out Stream_Element_Offset); | |
164 procedure Write (Stream : in out Dummy_Stream; | |
165 Item : Stream_Element_Array); | |
166 | |
167 end CD10002_1; | |
168 | |
169 | |
170 with Report; | |
171 use Report; | |
172 package body CD10002_1 is | |
173 | |
174 procedure Read (Stream : in out Dummy_Stream; | |
175 Item : out Stream_Element_Array; | |
176 Last : out Stream_Element_Offset) is | |
177 begin | |
178 Failed ("Unexpected call to the Read operation of Dummy_Stream"); | |
179 end Read; | |
180 | |
181 procedure Write (Stream : in out Dummy_Stream; | |
182 Item : Stream_Element_Array) is | |
183 begin | |
184 Failed ("Unexpected call to the Write operation of Dummy_Stream"); | |
185 end Write; | |
186 | |
187 end CD10002_1; | |
188 | |
189 | |
190 with Ada.Streams; | |
191 use Ada.Streams; | |
192 with CD10002_0; | |
193 package CD10002_Deriv is | |
194 | |
195 -- Parent has user-defined subprograms. | |
196 | |
197 type T1 is new Boolean; | |
198 function Is_Odd (X : Integer) return T1; | |
199 | |
200 type T2 is | |
201 record | |
202 F : Float; | |
203 end record; | |
204 procedure Print (X : T2); | |
205 | |
206 type T3 is array (Boolean) of Duration; | |
207 function "+" (L, R : T3) return T3; | |
208 | |
209 -- Parent is by-reference. No need to check the case where the parent | |
210 -- is tagged, because the defect report only deals with untagged types. | |
211 | |
212 task type T4 is | |
213 end T4; | |
214 | |
215 protected type T5 is | |
216 end T5; | |
217 | |
218 type T6 (D : access Integer := new Integer'(2)) is limited null record; | |
219 | |
220 type T7 is array (Character) of T6; | |
221 | |
222 package P is | |
223 type T8 is limited private; | |
224 private | |
225 type T8 is new T5; | |
226 end P; | |
227 | |
228 type Nt1 is new T1; | |
229 type Nt2 is new T2; | |
230 type Nt3 is new T3; | |
231 type Nt4 is new T4; | |
232 type Nt5 is new T5; | |
233 type Nt6 is new T6; | |
234 type Nt7 is new T7; | |
235 type Nt8 is new P.T8; | |
236 | |
237 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); | |
238 function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base; | |
239 procedure Read (Stream : access Root_Stream_Type'Class; | |
240 Item : out Nt1'Base); | |
241 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); | |
242 | |
243 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2); | |
244 function Input (Stream : access Root_Stream_Type'Class) return Nt2; | |
245 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2); | |
246 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2); | |
247 | |
248 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3); | |
249 function Input (Stream : access Root_Stream_Type'Class) return Nt3; | |
250 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3); | |
251 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3); | |
252 | |
253 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4); | |
254 function Input (Stream : access Root_Stream_Type'Class) return Nt4; | |
255 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4); | |
256 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4); | |
257 | |
258 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5); | |
259 function Input (Stream : access Root_Stream_Type'Class) return Nt5; | |
260 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5); | |
261 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5); | |
262 | |
263 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6); | |
264 function Input (Stream : access Root_Stream_Type'Class) return Nt6; | |
265 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6); | |
266 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6); | |
267 | |
268 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7); | |
269 function Input (Stream : access Root_Stream_Type'Class) return Nt7; | |
270 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7); | |
271 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7); | |
272 | |
273 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8); | |
274 function Input (Stream : access Root_Stream_Type'Class) return Nt8; | |
275 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8); | |
276 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8); | |
277 | |
278 for Nt1'Write use Write; | |
279 for Nt1'Read use Read; | |
280 for Nt1'Output use Output; | |
281 for Nt1'Input use Input; | |
282 | |
283 for Nt2'Write use Write; | |
284 for Nt2'Read use Read; | |
285 for Nt2'Output use Output; | |
286 for Nt2'Input use Input; | |
287 | |
288 for Nt3'Write use Write; | |
289 for Nt3'Read use Read; | |
290 for Nt3'Output use Output; | |
291 for Nt3'Input use Input; | |
292 | |
293 for Nt4'Write use Write; | |
294 for Nt4'Read use Read; | |
295 for Nt4'Output use Output; | |
296 for Nt4'Input use Input; | |
297 | |
298 for Nt5'Write use Write; | |
299 for Nt5'Read use Read; | |
300 for Nt5'Output use Output; | |
301 for Nt5'Input use Input; | |
302 | |
303 for Nt6'Write use Write; | |
304 for Nt6'Read use Read; | |
305 for Nt6'Output use Output; | |
306 for Nt6'Input use Input; | |
307 | |
308 for Nt7'Write use Write; | |
309 for Nt7'Read use Read; | |
310 for Nt7'Output use Output; | |
311 for Nt7'Input use Input; | |
312 | |
313 for Nt8'Write use Write; | |
314 for Nt8'Read use Read; | |
315 for Nt8'Output use Output; | |
316 for Nt8'Input use Input; | |
317 | |
318 -- All these variables are self-initializing. | |
319 C4 : Nt4; | |
320 C5 : Nt5; | |
321 C6 : Nt6; | |
322 C7 : Nt7; | |
323 C8 : Nt8; | |
324 | |
325 package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base); | |
326 package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2); | |
327 package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3); | |
328 package Nt4_Ops is new CD10002_0.Limited_Stream_Ops (Nt4, C4); | |
329 package Nt5_Ops is new CD10002_0.Limited_Stream_Ops (Nt5, C5); | |
330 package Nt6_Ops is new CD10002_0.Limited_Stream_Ops (Nt6, C6); | |
331 package Nt7_Ops is new CD10002_0.Limited_Stream_Ops (Nt7, C7); | |
332 package Nt8_Ops is new CD10002_0.Limited_Stream_Ops (Nt8, C8); | |
333 | |
334 end CD10002_Deriv; | |
335 | |
336 | |
337 package body CD10002_Deriv is | |
338 | |
339 function Is_Odd (X : Integer) return T1 is | |
340 begin | |
341 return True; | |
342 end Is_Odd; | |
343 procedure Print (X : T2) is | |
344 begin | |
345 null; | |
346 end Print; | |
347 function "+" (L, R : T3) return T3 is | |
348 begin | |
349 return (False => L (False) + R (True), True => L (True) + R (False)); | |
350 end "+"; | |
351 task body T4 is | |
352 begin | |
353 null; | |
354 end T4; | |
355 protected body T5 is | |
356 end T5; | |
357 | |
358 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) | |
359 renames Nt1_Ops.Write; | |
360 function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base | |
361 renames Nt1_Ops.Input; | |
362 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base) | |
363 renames Nt1_Ops.Read; | |
364 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) | |
365 renames Nt1_Ops.Output; | |
366 | |
367 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2) | |
368 renames Nt2_Ops.Write; | |
369 function Input (Stream : access Root_Stream_Type'Class) return Nt2 | |
370 renames Nt2_Ops.Input; | |
371 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2) | |
372 renames Nt2_Ops.Read; | |
373 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2) | |
374 renames Nt2_Ops.Output; | |
375 | |
376 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3) | |
377 renames Nt3_Ops.Write; | |
378 function Input (Stream : access Root_Stream_Type'Class) return Nt3 | |
379 renames Nt3_Ops.Input; | |
380 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3) | |
381 renames Nt3_Ops.Read; | |
382 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3) | |
383 renames Nt3_Ops.Output; | |
384 | |
385 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4) | |
386 renames Nt4_Ops.Write; | |
387 function Input (Stream : access Root_Stream_Type'Class) return Nt4 | |
388 renames Nt4_Ops.Input; | |
389 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4) | |
390 renames Nt4_Ops.Read; | |
391 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4) | |
392 renames Nt4_Ops.Output; | |
393 | |
394 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5) | |
395 renames Nt5_Ops.Write; | |
396 function Input (Stream : access Root_Stream_Type'Class) return Nt5 | |
397 renames Nt5_Ops.Input; | |
398 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5) | |
399 renames Nt5_Ops.Read; | |
400 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5) | |
401 renames Nt5_Ops.Output; | |
402 | |
403 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6) | |
404 renames Nt6_Ops.Write; | |
405 function Input (Stream : access Root_Stream_Type'Class) return Nt6 | |
406 renames Nt6_Ops.Input; | |
407 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6) | |
408 renames Nt6_Ops.Read; | |
409 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6) | |
410 renames Nt6_Ops.Output; | |
411 | |
412 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7) | |
413 renames Nt7_Ops.Write; | |
414 function Input (Stream : access Root_Stream_Type'Class) return Nt7 | |
415 renames Nt7_Ops.Input; | |
416 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7) | |
417 renames Nt7_Ops.Read; | |
418 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7) | |
419 renames Nt7_Ops.Output; | |
420 | |
421 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8) | |
422 renames Nt8_Ops.Write; | |
423 function Input (Stream : access Root_Stream_Type'Class) return Nt8 | |
424 renames Nt8_Ops.Input; | |
425 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8) | |
426 renames Nt8_Ops.Read; | |
427 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8) | |
428 renames Nt8_Ops.Output; | |
429 | |
430 end CD10002_Deriv; | |
431 | |
432 | |
433 with Ada.Streams; | |
434 use Ada.Streams; | |
435 with CD10002_0; | |
436 generic | |
437 type T1 is (<>); | |
438 type T2 is range <>; | |
439 type T3 is mod <>; | |
440 type T4 is digits <>; | |
441 type T5 is delta <>; | |
442 type T6 is delta <> digits <>; | |
443 type T7 is access T3; | |
444 type T8 is new Boolean; | |
445 type T9 is private; | |
446 type T10 (<>) is limited private; -- Should be self-initializing. | |
447 C10 : in out T10; | |
448 type T11 is array (T1) of T2; | |
449 package CD10002_Gen is | |
450 | |
451 -- Direct descendants. | |
452 type Nt1 is new T1; | |
453 type Nt2 is new T2; | |
454 type Nt3 is new T3; | |
455 type Nt4 is new T4; | |
456 type Nt5 is new T5; | |
457 type Nt6 is new T6; | |
458 type Nt7 is new T7; | |
459 type Nt8 is new T8; | |
460 type Nt9 is new T9; | |
461 type Nt10 is new T10; | |
462 type Nt11 is new T11; | |
463 | |
464 -- Indirect descendants (only pick two, a limited one and a non-limited | |
465 -- one). | |
466 type Nt12 is new Nt10; | |
467 type Nt13 is new Nt11; | |
468 | |
469 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); | |
470 function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base; | |
471 procedure Read (Stream : access Root_Stream_Type'Class; | |
472 Item : out Nt1'Base); | |
473 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); | |
474 | |
475 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base); | |
476 function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base; | |
477 procedure Read (Stream : access Root_Stream_Type'Class; | |
478 Item : out Nt2'Base); | |
479 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base); | |
480 | |
481 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base); | |
482 function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base; | |
483 procedure Read (Stream : access Root_Stream_Type'Class; | |
484 Item : out Nt3'Base); | |
485 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base); | |
486 | |
487 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base); | |
488 function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base; | |
489 procedure Read (Stream : access Root_Stream_Type'Class; | |
490 Item : out Nt4'Base); | |
491 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base); | |
492 | |
493 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base); | |
494 function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base; | |
495 procedure Read (Stream : access Root_Stream_Type'Class; | |
496 Item : out Nt5'Base); | |
497 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base); | |
498 | |
499 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base); | |
500 function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base; | |
501 procedure Read (Stream : access Root_Stream_Type'Class; | |
502 Item : out Nt6'Base); | |
503 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base); | |
504 | |
505 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7); | |
506 function Input (Stream : access Root_Stream_Type'Class) return Nt7; | |
507 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7); | |
508 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7); | |
509 | |
510 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base); | |
511 function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base; | |
512 procedure Read (Stream : access Root_Stream_Type'Class; | |
513 Item : out Nt8'Base); | |
514 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base); | |
515 | |
516 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9); | |
517 function Input (Stream : access Root_Stream_Type'Class) return Nt9; | |
518 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9); | |
519 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9); | |
520 | |
521 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10); | |
522 function Input (Stream : access Root_Stream_Type'Class) return Nt10; | |
523 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10); | |
524 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10); | |
525 | |
526 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11); | |
527 function Input (Stream : access Root_Stream_Type'Class) return Nt11; | |
528 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11); | |
529 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11); | |
530 | |
531 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12); | |
532 function Input (Stream : access Root_Stream_Type'Class) return Nt12; | |
533 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12); | |
534 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12); | |
535 | |
536 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13); | |
537 function Input (Stream : access Root_Stream_Type'Class) return Nt13; | |
538 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13); | |
539 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13); | |
540 | |
541 for Nt1'Write use Write; | |
542 for Nt1'Read use Read; | |
543 for Nt1'Output use Output; | |
544 for Nt1'Input use Input; | |
545 | |
546 for Nt2'Write use Write; | |
547 for Nt2'Read use Read; | |
548 for Nt2'Output use Output; | |
549 for Nt2'Input use Input; | |
550 | |
551 for Nt3'Write use Write; | |
552 for Nt3'Read use Read; | |
553 for Nt3'Output use Output; | |
554 for Nt3'Input use Input; | |
555 | |
556 for Nt4'Write use Write; | |
557 for Nt4'Read use Read; | |
558 for Nt4'Output use Output; | |
559 for Nt4'Input use Input; | |
560 | |
561 for Nt5'Write use Write; | |
562 for Nt5'Read use Read; | |
563 for Nt5'Output use Output; | |
564 for Nt5'Input use Input; | |
565 | |
566 for Nt6'Write use Write; | |
567 for Nt6'Read use Read; | |
568 for Nt6'Output use Output; | |
569 for Nt6'Input use Input; | |
570 | |
571 for Nt7'Write use Write; | |
572 for Nt7'Read use Read; | |
573 for Nt7'Output use Output; | |
574 for Nt7'Input use Input; | |
575 | |
576 for Nt8'Write use Write; | |
577 for Nt8'Read use Read; | |
578 for Nt8'Output use Output; | |
579 for Nt8'Input use Input; | |
580 | |
581 for Nt9'Write use Write; | |
582 for Nt9'Read use Read; | |
583 for Nt9'Output use Output; | |
584 for Nt9'Input use Input; | |
585 | |
586 for Nt10'Write use Write; | |
587 for Nt10'Read use Read; | |
588 for Nt10'Output use Output; | |
589 for Nt10'Input use Input; | |
590 | |
591 for Nt11'Write use Write; | |
592 for Nt11'Read use Read; | |
593 for Nt11'Output use Output; | |
594 for Nt11'Input use Input; | |
595 | |
596 for Nt12'Write use Write; | |
597 for Nt12'Read use Read; | |
598 for Nt12'Output use Output; | |
599 for Nt12'Input use Input; | |
600 | |
601 for Nt13'Write use Write; | |
602 for Nt13'Read use Read; | |
603 for Nt13'Output use Output; | |
604 for Nt13'Input use Input; | |
605 | |
606 type Null_Record is null record; | |
607 | |
608 package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base); | |
609 package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2'Base); | |
610 package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3'Base); | |
611 package Nt4_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt4'Base); | |
612 package Nt5_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt5'Base); | |
613 package Nt6_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt6'Base); | |
614 package Nt7_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt7); | |
615 package Nt8_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt8'Base); | |
616 package Nt9_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt9); | |
617 package Nt11_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt11); | |
618 package Nt13_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt13); | |
619 | |
620 function Get_Nt10_Counts return CD10002_0.Counts; | |
621 function Get_Nt12_Counts return CD10002_0.Counts; | |
622 | |
623 end CD10002_Gen; | |
624 | |
625 | |
626 package body CD10002_Gen is | |
627 | |
628 use CD10002_0; | |
629 | |
630 Nt10_Cnts : Counts := (others => 0); | |
631 Nt12_Cnts : Counts := (others => 0); | |
632 | |
633 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) | |
634 renames Nt1_Ops.Write; | |
635 function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base | |
636 renames Nt1_Ops.Input; | |
637 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base) | |
638 renames Nt1_Ops.Read; | |
639 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) | |
640 renames Nt1_Ops.Output; | |
641 | |
642 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base) | |
643 renames Nt2_Ops.Write; | |
644 function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base | |
645 renames Nt2_Ops.Input; | |
646 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2'Base) | |
647 renames Nt2_Ops.Read; | |
648 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base) | |
649 renames Nt2_Ops.Output; | |
650 | |
651 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base) | |
652 renames Nt3_Ops.Write; | |
653 function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base | |
654 renames Nt3_Ops.Input; | |
655 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3'Base) | |
656 renames Nt3_Ops.Read; | |
657 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base) | |
658 renames Nt3_Ops.Output; | |
659 | |
660 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base) | |
661 renames Nt4_Ops.Write; | |
662 function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base | |
663 renames Nt4_Ops.Input; | |
664 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4'Base) | |
665 renames Nt4_Ops.Read; | |
666 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base) | |
667 renames Nt4_Ops.Output; | |
668 | |
669 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base) | |
670 renames Nt5_Ops.Write; | |
671 function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base | |
672 renames Nt5_Ops.Input; | |
673 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5'Base) | |
674 renames Nt5_Ops.Read; | |
675 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base) | |
676 renames Nt5_Ops.Output; | |
677 | |
678 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base) | |
679 renames Nt6_Ops.Write; | |
680 function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base | |
681 renames Nt6_Ops.Input; | |
682 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6'Base) | |
683 renames Nt6_Ops.Read; | |
684 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base) | |
685 renames Nt6_Ops.Output; | |
686 | |
687 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7) | |
688 renames Nt7_Ops.Write; | |
689 function Input (Stream : access Root_Stream_Type'Class) return Nt7 | |
690 renames Nt7_Ops.Input; | |
691 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7) | |
692 renames Nt7_Ops.Read; | |
693 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7) | |
694 renames Nt7_Ops.Output; | |
695 | |
696 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base) | |
697 renames Nt8_Ops.Write; | |
698 function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base | |
699 renames Nt8_Ops.Input; | |
700 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8'Base) | |
701 renames Nt8_Ops.Read; | |
702 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base) | |
703 renames Nt8_Ops.Output; | |
704 | |
705 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9) | |
706 renames Nt9_Ops.Write; | |
707 function Input (Stream : access Root_Stream_Type'Class) return Nt9 | |
708 renames Nt9_Ops.Input; | |
709 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9) | |
710 renames Nt9_Ops.Read; | |
711 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9) | |
712 renames Nt9_Ops.Output; | |
713 | |
714 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10) is | |
715 begin | |
716 Nt10_Cnts (Write) := Nt10_Cnts (Write) + 1; | |
717 end Write; | |
718 function Input (Stream : access Root_Stream_Type'Class) return Nt10 is | |
719 begin | |
720 Nt10_Cnts (Input) := Nt10_Cnts (Input) + 1; | |
721 return Nt10 (C10); | |
722 end Input; | |
723 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10) is | |
724 begin | |
725 Nt10_Cnts (Read) := Nt10_Cnts (Read) + 1; | |
726 end Read; | |
727 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10) is | |
728 begin | |
729 Nt10_Cnts (Output) := Nt10_Cnts (Output) + 1; | |
730 end Output; | |
731 function Get_Nt10_Counts return CD10002_0.Counts is | |
732 begin | |
733 return Nt10_Cnts; | |
734 end Get_Nt10_Counts; | |
735 | |
736 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11) | |
737 renames Nt11_Ops.Write; | |
738 function Input (Stream : access Root_Stream_Type'Class) return Nt11 | |
739 renames Nt11_Ops.Input; | |
740 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11) | |
741 renames Nt11_Ops.Read; | |
742 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11) | |
743 renames Nt11_Ops.Output; | |
744 | |
745 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12) is | |
746 begin | |
747 Nt12_Cnts (Write) := Nt12_Cnts (Write) + 1; | |
748 end Write; | |
749 function Input (Stream : access Root_Stream_Type'Class) return Nt12 is | |
750 begin | |
751 Nt12_Cnts (Input) := Nt12_Cnts (Input) + 1; | |
752 return Nt12 (C10); | |
753 end Input; | |
754 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12) is | |
755 begin | |
756 Nt12_Cnts (Read) := Nt12_Cnts (Read) + 1; | |
757 end Read; | |
758 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12) is | |
759 begin | |
760 Nt12_Cnts (Output) := Nt12_Cnts (Output) + 1; | |
761 end Output; | |
762 function Get_Nt12_Counts return CD10002_0.Counts is | |
763 begin | |
764 return Nt12_Cnts; | |
765 end Get_Nt12_Counts; | |
766 | |
767 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13) | |
768 renames Nt13_Ops.Write; | |
769 function Input (Stream : access Root_Stream_Type'Class) return Nt13 | |
770 renames Nt13_Ops.Input; | |
771 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13) | |
772 renames Nt13_Ops.Read; | |
773 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13) | |
774 renames Nt13_Ops.Output; | |
775 | |
776 end CD10002_Gen; | |
777 | |
778 | |
779 with Ada.Streams; | |
780 use Ada.Streams; | |
781 with CD10002_0; | |
782 package CD10002_Priv is | |
783 | |
784 External_Tag_1 : constant String := "Isaac Newton"; | |
785 External_Tag_2 : constant String := "Albert Einstein"; | |
786 | |
787 type T1 is tagged private; | |
788 type T2 is tagged | |
789 record | |
790 C : T1; | |
791 end record; | |
792 | |
793 procedure Write (Stream : access Root_Stream_Type'Class; Item : T1); | |
794 function Input (Stream : access Root_Stream_Type'Class) return T1; | |
795 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1); | |
796 procedure Output (Stream : access Root_Stream_Type'Class; Item : T1); | |
797 | |
798 procedure Write (Stream : access Root_Stream_Type'Class; Item : T2); | |
799 function Input (Stream : access Root_Stream_Type'Class) return T2; | |
800 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2); | |
801 procedure Output (Stream : access Root_Stream_Type'Class; Item : T2); | |
802 | |
803 for T1'Write use Write; | |
804 for T1'Input use Input; | |
805 | |
806 for T2'Read use Read; | |
807 for T2'Output use Output; | |
808 for T2'External_Tag use External_Tag_2; | |
809 | |
810 function Get_T1_Counts return CD10002_0.Counts; | |
811 function Get_T2_Counts return CD10002_0.Counts; | |
812 | |
813 private | |
814 | |
815 for T1'Read use Read; | |
816 for T1'Output use Output; | |
817 for T1'External_Tag use External_Tag_1; | |
818 | |
819 for T2'Write use Write; | |
820 for T2'Input use Input; | |
821 | |
822 type T1 is tagged null record; | |
823 | |
824 package T1_Ops is new CD10002_0.Nonlimited_Stream_Ops (T1); | |
825 package T2_Ops is new CD10002_0.Nonlimited_Stream_Ops (T2); | |
826 | |
827 end CD10002_Priv; | |
828 | |
829 | |
830 package body CD10002_Priv is | |
831 procedure Write (Stream : access Root_Stream_Type'Class; Item : T1) | |
832 renames T1_Ops.Write; | |
833 function Input (Stream : access Root_Stream_Type'Class) return T1 | |
834 renames T1_Ops.Input; | |
835 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1) | |
836 renames T1_Ops.Read; | |
837 procedure Output (Stream : access Root_Stream_Type'Class; Item : T1) | |
838 renames T1_Ops.Output; | |
839 | |
840 procedure Write (Stream : access Root_Stream_Type'Class; Item : T2) | |
841 renames T2_Ops.Write; | |
842 function Input (Stream : access Root_Stream_Type'Class) return T2 | |
843 renames T2_Ops.Input; | |
844 procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2) | |
845 renames T2_Ops.Read; | |
846 procedure Output (Stream : access Root_Stream_Type'Class; Item : T2) | |
847 renames T2_Ops.Output; | |
848 | |
849 function Get_T1_Counts return CD10002_0.Counts renames T1_Ops.Get_Counts; | |
850 function Get_T2_Counts return CD10002_0.Counts renames T2_Ops.Get_Counts; | |
851 end CD10002_Priv; | |
852 | |
853 | |
854 with Ada.Streams; | |
855 use Ada.Streams; | |
856 with Report; | |
857 use Report; | |
858 with System; | |
859 with CD10002_0; | |
860 with CD10002_1; | |
861 with CD10002_Deriv; | |
862 with CD10002_Gen; | |
863 with CD10002_Priv; | |
864 procedure CD10002 is | |
865 | |
866 package Deriv renames CD10002_Deriv; | |
867 generic package Gen renames CD10002_Gen; | |
868 package Priv renames CD10002_Priv; | |
869 | |
870 type Stream_Ops is (Read, Write, Input, Output); | |
871 type Counts is array (Stream_Ops) of Natural; | |
872 | |
873 S : aliased CD10002_1.Dummy_Stream; | |
874 | |
875 begin | |
876 Test ("CD10002", | |
877 "Check that operational items are allowed in some contexts " & | |
878 "where representation items are not"); | |
879 | |
880 Test_Priv: | |
881 declare | |
882 X1 : Priv.T1; | |
883 X2 : Priv.T2; | |
884 use CD10002_0; | |
885 begin | |
886 Comment | |
887 ("Check that the name of an incompletely defined type can be " & | |
888 "used when specifying an operational item"); | |
889 | |
890 -- Partial view of a private type. | |
891 Priv.T1'Write (S'Access, X1); | |
892 Priv.T1'Read (S'Access, X1); | |
893 Priv.T1'Output (S'Access, X1); | |
894 X1 := Priv.T1'Input (S'Access); | |
895 | |
896 if Priv.Get_T1_Counts /= (1, 1, 1, 1) then | |
897 Failed ("Incorrect calls to the stream attributes for Priv.T1"); | |
898 elsif Priv.T1'External_Tag /= Priv.External_Tag_1 then | |
899 Failed ("Incorrect external tag for Priv.T1"); | |
900 end if; | |
901 | |
902 -- Incompletely defined but not private. | |
903 Priv.T2'Write (S'Access, X2); | |
904 Priv.T2'Read (S'Access, X2); | |
905 Priv.T2'Output (S'Access, X2); | |
906 X2 := Priv.T2'Input (S'Access); | |
907 | |
908 if Priv.Get_T2_Counts /= (1, 1, 1, 1) then | |
909 Failed ("Incorrect calls to the stream attributes for Priv.T2"); | |
910 elsif Priv.T2'External_Tag /= Priv.External_Tag_2 then | |
911 Failed ("Incorrect external tag for Priv.T2"); | |
912 end if; | |
913 | |
914 end Test_Priv; | |
915 | |
916 Test_Gen: | |
917 declare | |
918 | |
919 type Modular is mod System.Max_Binary_Modulus; | |
920 type Decimal is delta 1.0 digits 1; | |
921 type Access_Modular is access Modular; | |
922 type R9 is null record; | |
923 type R10 (D : access Integer) is limited null record; | |
924 type Arr is array (Character) of Integer; | |
925 | |
926 C10 : R10 (new Integer'(19)); | |
927 | |
928 package Inst is new Gen (T1 => Character, | |
929 T2 => Integer, | |
930 T3 => Modular, | |
931 T4 => Float, | |
932 T5 => Duration, | |
933 T6 => Decimal, | |
934 T7 => Access_Modular, | |
935 T8 => Boolean, | |
936 T9 => R9, | |
937 T10 => R10, | |
938 C10 => C10, | |
939 T11 => Arr); | |
940 | |
941 X1 : Inst.Nt1 := 'a'; | |
942 X2 : Inst.Nt2 := 0; | |
943 X3 : Inst.Nt3 := 0; | |
944 X4 : Inst.Nt4 := 0.0; | |
945 X5 : Inst.Nt5 := 0.0; | |
946 X6 : Inst.Nt6 := 0.0; | |
947 X7 : Inst.Nt7 := null; | |
948 X8 : Inst.Nt8 := Inst.False; | |
949 X9 : Inst.Nt9 := (null record); | |
950 X10 : Inst.Nt10 (D => new Integer'(5)); | |
951 Y10 : Integer; | |
952 X11 : Inst.Nt11 := (others => 0); | |
953 X12 : Inst.Nt12 (D => new Integer'(7)); | |
954 Y12 : Integer; | |
955 X13 : Inst.Nt13 := (others => 0); | |
956 use CD10002_0; | |
957 begin | |
958 Comment ("Check that operational items can be specified for a " & | |
959 "descendant of a generic formal untagged type"); | |
960 | |
961 Inst.Nt1'Write (S'Access, X1); | |
962 Inst.Nt1'Read (S'Access, X1); | |
963 Inst.Nt1'Output (S'Access, X1); | |
964 X1 := Inst.Nt1'Input (S'Access); | |
965 | |
966 if Inst.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then | |
967 Failed | |
968 ("Incorrect calls to the stream attributes for Inst.Nt1"); | |
969 end if; | |
970 | |
971 Inst.Nt2'Write (S'Access, X2); | |
972 Inst.Nt2'Read (S'Access, X2); | |
973 Inst.Nt2'Output (S'Access, X2); | |
974 X2 := Inst.Nt2'Input (S'Access); | |
975 | |
976 if Inst.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then | |
977 Failed | |
978 ("Incorrect calls to the stream attributes for Inst.Nt2"); | |
979 end if; | |
980 | |
981 Inst.Nt3'Write (S'Access, X3); | |
982 Inst.Nt3'Read (S'Access, X3); | |
983 Inst.Nt3'Output (S'Access, X3); | |
984 X3 := Inst.Nt3'Input (S'Access); | |
985 | |
986 if Inst.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then | |
987 Failed | |
988 ("Incorrect calls to the stream attributes for Inst.Nt3"); | |
989 end if; | |
990 | |
991 Inst.Nt4'Write (S'Access, X4); | |
992 Inst.Nt4'Read (S'Access, X4); | |
993 Inst.Nt4'Output (S'Access, X4); | |
994 X4 := Inst.Nt4'Input (S'Access); | |
995 | |
996 if Inst.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then | |
997 Failed | |
998 ("Incorrect calls to the stream attributes for Inst.Nt4"); | |
999 end if; | |
1000 | |
1001 Inst.Nt5'Write (S'Access, X5); | |
1002 Inst.Nt5'Read (S'Access, X5); | |
1003 Inst.Nt5'Output (S'Access, X5); | |
1004 X5 := Inst.Nt5'Input (S'Access); | |
1005 | |
1006 if Inst.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1007 Failed | |
1008 ("Incorrect calls to the stream attributes for Inst.Nt5"); | |
1009 end if; | |
1010 | |
1011 Inst.Nt6'Write (S'Access, X6); | |
1012 Inst.Nt6'Read (S'Access, X6); | |
1013 Inst.Nt6'Output (S'Access, X6); | |
1014 X6 := Inst.Nt6'Input (S'Access); | |
1015 | |
1016 if Inst.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1017 Failed | |
1018 ("Incorrect calls to the stream attributes for Inst.Nt6"); | |
1019 end if; | |
1020 | |
1021 Inst.Nt7'Write (S'Access, X7); | |
1022 Inst.Nt7'Read (S'Access, X7); | |
1023 Inst.Nt7'Output (S'Access, X7); | |
1024 X7 := Inst.Nt7'Input (S'Access); | |
1025 | |
1026 if Inst.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1027 Failed | |
1028 ("Incorrect calls to the stream attributes for Inst.Nt7"); | |
1029 end if; | |
1030 | |
1031 Inst.Nt8'Write (S'Access, X8); | |
1032 Inst.Nt8'Read (S'Access, X8); | |
1033 Inst.Nt8'Output (S'Access, X8); | |
1034 X8 := Inst.Nt8'Input (S'Access); | |
1035 | |
1036 if Inst.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1037 Failed | |
1038 ("Incorrect calls to the stream attributes for Inst.Nt8"); | |
1039 end if; | |
1040 | |
1041 Inst.Nt9'Write (S'Access, X9); | |
1042 Inst.Nt9'Read (S'Access, X9); | |
1043 Inst.Nt9'Output (S'Access, X9); | |
1044 X9 := Inst.Nt9'Input (S'Access); | |
1045 | |
1046 if Inst.Nt9_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1047 Failed | |
1048 ("Incorrect calls to the stream attributes for Inst.Nt9"); | |
1049 end if; | |
1050 | |
1051 Inst.Nt10'Write (S'Access, X10); | |
1052 Inst.Nt10'Read (S'Access, X10); | |
1053 Inst.Nt10'Output (S'Access, X10); | |
1054 Y10 := Inst.Nt10'Input (S'Access).D.all; | |
1055 | |
1056 if Inst.Get_Nt10_Counts /= (1, 1, 1, 1) then | |
1057 Failed | |
1058 ("Incorrect calls to the stream attributes for Inst.Nt10"); | |
1059 end if; | |
1060 | |
1061 Inst.Nt11'Write (S'Access, X11); | |
1062 Inst.Nt11'Read (S'Access, X11); | |
1063 Inst.Nt11'Output (S'Access, X11); | |
1064 X11 := Inst.Nt11'Input (S'Access); | |
1065 | |
1066 if Inst.Nt11_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1067 Failed | |
1068 ("Incorrect calls to the stream attributes for Inst.Nt11"); | |
1069 end if; | |
1070 | |
1071 Inst.Nt12'Write (S'Access, X12); | |
1072 Inst.Nt12'Read (S'Access, X12); | |
1073 Inst.Nt12'Output (S'Access, X12); | |
1074 Y12 := Inst.Nt12'Input (S'Access).D.all; | |
1075 | |
1076 if Inst.Get_Nt12_Counts /= (1, 1, 1, 1) then | |
1077 Failed | |
1078 ("Incorrect calls to the stream attributes for Inst.Nt12"); | |
1079 end if; | |
1080 | |
1081 Inst.Nt13'Write (S'Access, X13); | |
1082 Inst.Nt13'Read (S'Access, X13); | |
1083 Inst.Nt13'Output (S'Access, X13); | |
1084 X13 := Inst.Nt13'Input (S'Access); | |
1085 | |
1086 if Inst.Nt13_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1087 Failed | |
1088 ("Incorrect calls to the stream attributes for Inst.Nt13"); | |
1089 end if; | |
1090 end Test_Gen; | |
1091 | |
1092 Test_Deriv: | |
1093 declare | |
1094 X1 : Deriv.Nt1 := Deriv.False; | |
1095 X2 : Deriv.Nt2 := (others => 0.0); | |
1096 X3 : Deriv.Nt3 := (others => 0.0); | |
1097 X4 : Deriv.Nt4; | |
1098 Y4 : Boolean; | |
1099 X5 : Deriv.Nt5; | |
1100 Y5 : System.Address; | |
1101 X6 : Deriv.Nt6; | |
1102 Y6 : Integer; | |
1103 X7 : Deriv.Nt7; | |
1104 Y7 : Integer; | |
1105 X8 : Deriv.Nt8; | |
1106 Y8 : Integer; | |
1107 use CD10002_0; | |
1108 begin | |
1109 Comment ("Check that operational items can be specified for a " & | |
1110 "derived untagged type even if the parent type is a " & | |
1111 "by-reference type, or has user-defined primitive " & | |
1112 "subprograms"); | |
1113 | |
1114 Deriv.Nt1'Write (S'Access, X1); | |
1115 Deriv.Nt1'Read (S'Access, X1); | |
1116 Deriv.Nt1'Output (S'Access, X1); | |
1117 X1 := Deriv.Nt1'Input (S'Access); | |
1118 | |
1119 if Deriv.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1120 Failed | |
1121 ("Incorrect calls to the stream attributes for Deriv.Nt1"); | |
1122 end if; | |
1123 | |
1124 Deriv.Nt2'Write (S'Access, X2); | |
1125 Deriv.Nt2'Read (S'Access, X2); | |
1126 Deriv.Nt2'Output (S'Access, X2); | |
1127 X2 := Deriv.Nt2'Input (S'Access); | |
1128 | |
1129 if Deriv.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1130 Failed | |
1131 ("Incorrect calls to the stream attributes for Deriv.Nt2"); | |
1132 end if; | |
1133 | |
1134 Deriv.Nt3'Write (S'Access, X3); | |
1135 Deriv.Nt3'Read (S'Access, X3); | |
1136 Deriv.Nt3'Output (S'Access, X3); | |
1137 X3 := Deriv.Nt3'Input (S'Access); | |
1138 | |
1139 if Deriv.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1140 Failed | |
1141 ("Incorrect calls to the stream attributes for Deriv.Nt3"); | |
1142 end if; | |
1143 | |
1144 Deriv.Nt4'Write (S'Access, X4); | |
1145 Deriv.Nt4'Read (S'Access, X4); | |
1146 Deriv.Nt4'Output (S'Access, X4); | |
1147 Y4 := Deriv.Nt4'Input (S'Access)'Terminated; | |
1148 | |
1149 if Deriv.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1150 Failed | |
1151 ("Incorrect calls to the stream attributes for Deriv.Nt4"); | |
1152 end if; | |
1153 | |
1154 Deriv.Nt5'Write (S'Access, X5); | |
1155 Deriv.Nt5'Read (S'Access, X5); | |
1156 Deriv.Nt5'Output (S'Access, X5); | |
1157 Y5 := Deriv.Nt5'Input (S'Access)'Address; | |
1158 | |
1159 if Deriv.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1160 Failed | |
1161 ("Incorrect calls to the stream attributes for Deriv.Nt5"); | |
1162 end if; | |
1163 | |
1164 Deriv.Nt6'Write (S'Access, X6); | |
1165 Deriv.Nt6'Read (S'Access, X6); | |
1166 Deriv.Nt6'Output (S'Access, X6); | |
1167 Y6 := Deriv.Nt6'Input (S'Access).D.all; | |
1168 | |
1169 if Deriv.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1170 Failed | |
1171 ("Incorrect calls to the stream attributes for Deriv.Nt6"); | |
1172 end if; | |
1173 | |
1174 Deriv.Nt7'Write (S'Access, X7); | |
1175 Deriv.Nt7'Read (S'Access, X7); | |
1176 Deriv.Nt7'Output (S'Access, X7); | |
1177 Y7 := Deriv.Nt7'Input (S'Access) ('a').D.all; | |
1178 | |
1179 if Deriv.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1180 Failed | |
1181 ("Incorrect calls to the stream attributes for Deriv.Nt7"); | |
1182 end if; | |
1183 | |
1184 Deriv.Nt8'Write (S'Access, X8); | |
1185 Deriv.Nt8'Read (S'Access, X8); | |
1186 Deriv.Nt8'Output (S'Access, X8); | |
1187 Y8 := Deriv.Nt8'Input (S'Access)'Size; | |
1188 | |
1189 if Deriv.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then | |
1190 Failed | |
1191 ("Incorrect calls to the stream attributes for Deriv.Nt8"); | |
1192 end if; | |
1193 end Test_Deriv; | |
1194 | |
1195 Result; | |
1196 end CD10002; | |
1197 | |
1198 |