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