3 -- Grant of Unlimited Rights
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.
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.
27 -- Check that operational items are allowed in some contexts where
28 -- representation items are not:
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)).
33 -- 2 - Check that operational items can be specified for a descendant of
34 -- a generic formal untagged type. (RM95/TC1 13.1(10)).
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)).
40 -- (Defect Report 8652/0009, as reflected in Technical Corrigendum 1).
43 -- 19 JAN 2001 PHL Initial version.
44 -- 3 DEC 2001 RLB Reformatted for ACATS.
45 -- 3 OCT 2002 RLB Corrected incorrect type derivations.
52 type Kinds
is (Read
, Write
, Input
, Output
);
53 type Counts
is array (Kinds
) of Natural;
57 package Nonlimited_Stream_Ops
is
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
);
64 function Get_Counts
return Counts
;
66 end Nonlimited_Stream_Ops
;
69 type T
(<>) is limited private; -- Should be self-initializing.
71 package Limited_Stream_Ops
is
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
);
78 function Get_Counts
return Counts
;
80 end Limited_Stream_Ops
;
85 package body CD10002_0
is
87 package body Nonlimited_Stream_Ops
is
88 Cnts
: Counts
:= (others => 0);
89 X
: T
; -- Initialized by Write/Output.
91 procedure Write
(Stream
: access Root_Stream_Type
'Class; Item
: T
) is
94 Cnts
(Write
) := Cnts
(Write
) + 1;
97 function Input
(Stream
: access Root_Stream_Type
'Class) return T
is
99 Cnts
(Input
) := Cnts
(Input
) + 1;
103 procedure Read
(Stream
: access Root_Stream_Type
'Class; Item
: out T
) is
105 Cnts
(Read
) := Cnts
(Read
) + 1;
109 procedure Output
(Stream
: access Root_Stream_Type
'Class; Item
: T
) is
112 Cnts
(Output
) := Cnts
(Output
) + 1;
115 function Get_Counts
return Counts
is
120 end Nonlimited_Stream_Ops
;
122 package body Limited_Stream_Ops
is
123 Cnts
: Counts
:= (others => 0);
125 procedure Write
(Stream
: access Root_Stream_Type
'Class; Item
: T
) is
127 Cnts
(Write
) := Cnts
(Write
) + 1;
130 function Input
(Stream
: access Root_Stream_Type
'Class) return T
is
132 Cnts
(Input
) := Cnts
(Input
) + 1;
136 procedure Read
(Stream
: access Root_Stream_Type
'Class; Item
: out T
) is
138 Cnts
(Read
) := Cnts
(Read
) + 1;
141 procedure Output
(Stream
: access Root_Stream_Type
'Class; Item
: T
) is
143 Cnts
(Output
) := Cnts
(Output
) + 1;
146 function Get_Counts
return Counts
is
151 end Limited_Stream_Ops
;
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
);
172 package body CD10002_1
is
174 procedure Read
(Stream
: in out Dummy_Stream
;
175 Item
: out Stream_Element_Array
;
176 Last
: out Stream_Element_Offset
) is
178 Failed
("Unexpected call to the Read operation of Dummy_Stream");
181 procedure Write
(Stream
: in out Dummy_Stream
;
182 Item
: Stream_Element_Array
) is
184 Failed
("Unexpected call to the Write operation of Dummy_Stream");
193 package CD10002_Deriv
is
195 -- Parent has user-defined subprograms.
197 type T1
is new Boolean;
198 function Is_Odd
(X
: Integer) return T1
;
204 procedure Print
(X
: T2
);
206 type T3
is array (Boolean) of Duration;
207 function "+" (L
, R
: T3
) return T3
;
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.
218 type T6
(D
: access Integer := new Integer'(2)) is limited null record;
220 type T7 is array (Character) of T6;
223 type T8 is limited private;
235 type Nt8 is new P.T8;
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);
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);
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);
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);
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);
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);
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);
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);
278 for Nt1'Write use Write;
279 for Nt1'Read use Read;
280 for Nt1'Output use Output;
281 for Nt1'Input use Input;
283 for Nt2'Write use Write;
284 for Nt2'Read use Read;
285 for Nt2'Output use Output;
286 for Nt2'Input use Input;
288 for Nt3'Write use Write;
289 for Nt3'Read use Read;
290 for Nt3'Output use Output;
291 for Nt3'Input use Input;
293 for Nt4'Write use Write;
294 for Nt4'Read use Read;
295 for Nt4'Output use Output;
296 for Nt4'Input use Input;
298 for Nt5'Write use Write;
299 for Nt5'Read use Read;
300 for Nt5'Output use Output;
301 for Nt5'Input use Input;
303 for Nt6'Write use Write;
304 for Nt6'Read use Read;
305 for Nt6'Output use Output;
306 for Nt6'Input use Input;
308 for Nt7'Write use Write;
309 for Nt7'Read use Read;
310 for Nt7'Output use Output;
311 for Nt7'Input use Input;
313 for Nt8'Write use Write;
314 for Nt8'Read use Read;
315 for Nt8'Output use Output;
316 for Nt8'Input use Input;
318 -- All these variables are self-initializing.
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);
337 package body CD10002_Deriv is
339 function Is_Odd (X : Integer) return T1 is
343 procedure Print (X : T2) is
347 function "+" (L, R : T3) return T3 is
349 return (False => L (False) + R (True), True => L (True) + R (False));
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;
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;
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;
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;
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;
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;
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;
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;
440 type T4 is digits <>;
442 type T6 is delta <> digits <>;
443 type T7 is access T3;
444 type T8 is new Boolean;
446 type T10 (<>) is limited private; -- Should be self-initializing.
448 type T11 is array (T1) of T2;
449 package CD10002_Gen is
451 -- Direct descendants.
461 type Nt10 is new T10;
462 type Nt11 is new T11;
464 -- Indirect descendants (only pick two, a limited one and a non-limited
466 type Nt12 is new Nt10;
467 type Nt13 is new Nt11;
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);
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);
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);
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);
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);
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);
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);
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);
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);
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);
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);
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);
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);
541 for Nt1'Write use Write;
542 for Nt1'Read use Read;
543 for Nt1'Output use Output;
544 for Nt1'Input use Input;
546 for Nt2'Write use Write;
547 for Nt2'Read use Read;
548 for Nt2'Output use Output;
549 for Nt2'Input use Input;
551 for Nt3'Write use Write;
552 for Nt3'Read use Read;
553 for Nt3'Output use Output;
554 for Nt3'Input use Input;
556 for Nt4'Write use Write;
557 for Nt4'Read use Read;
558 for Nt4'Output use Output;
559 for Nt4'Input use Input;
561 for Nt5'Write use Write;
562 for Nt5'Read use Read;
563 for Nt5'Output use Output;
564 for Nt5'Input use Input;
566 for Nt6'Write use Write;
567 for Nt6'Read use Read;
568 for Nt6'Output use Output;
569 for Nt6'Input use Input;
571 for Nt7'Write use Write;
572 for Nt7'Read use Read;
573 for Nt7'Output use Output;
574 for Nt7'Input use Input;
576 for Nt8'Write use Write;
577 for Nt8'Read use Read;
578 for Nt8'Output use Output;
579 for Nt8'Input use Input;
581 for Nt9'Write use Write;
582 for Nt9'Read use Read;
583 for Nt9'Output use Output;
584 for Nt9'Input use Input;
586 for Nt10'Write use Write;
587 for Nt10'Read use Read;
588 for Nt10'Output use Output;
589 for Nt10'Input use Input;
591 for Nt11'Write use Write;
592 for Nt11'Read use Read;
593 for Nt11'Output use Output;
594 for Nt11'Input use Input;
596 for Nt12'Write use Write;
597 for Nt12'Read use Read;
598 for Nt12'Output use Output;
599 for Nt12'Input use Input;
601 for Nt13'Write use Write;
602 for Nt13'Read use Read;
603 for Nt13'Output use Output;
604 for Nt13'Input use Input;
606 type Null_Record is null record;
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);
620 function Get_Nt10_Counts return CD10002_0.Counts;
621 function Get_Nt12_Counts return CD10002_0.Counts;
626 package body CD10002_Gen is
630 Nt10_Cnts : Counts := (others => 0);
631 Nt12_Cnts : Counts := (others => 0);
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;
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;
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;
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;
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;
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;
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;
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;
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;
714 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10) is
716 Nt10_Cnts (Write) := Nt10_Cnts (Write) + 1;
718 function Input (Stream : access Root_Stream_Type'Class) return Nt10 is
720 Nt10_Cnts (Input) := Nt10_Cnts (Input) + 1;
723 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10) is
725 Nt10_Cnts (Read) := Nt10_Cnts (Read) + 1;
727 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10) is
729 Nt10_Cnts (Output) := Nt10_Cnts (Output) + 1;
731 function Get_Nt10_Counts return CD10002_0.Counts is
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;
745 procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12) is
747 Nt12_Cnts (Write) := Nt12_Cnts (Write) + 1;
749 function Input (Stream : access Root_Stream_Type'Class) return Nt12 is
751 Nt12_Cnts (Input) := Nt12_Cnts (Input) + 1;
754 procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12) is
756 Nt12_Cnts (Read) := Nt12_Cnts (Read) + 1;
758 procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12) is
760 Nt12_Cnts (Output) := Nt12_Cnts (Output) + 1;
762 function Get_Nt12_Counts return CD10002_0.Counts is
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;
782 package CD10002_Priv is
784 External_Tag_1 : constant String := "Isaac Newton";
785 External_Tag_2 : constant String := "Albert Einstein";
787 type T1 is tagged private;
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);
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);
803 for T1'Write use Write;
804 for T1'Input use Input;
806 for T2'Read use Read;
807 for T2'Output use Output;
808 for T2'External_Tag use External_Tag_2;
810 function Get_T1_Counts return CD10002_0.Counts;
811 function Get_T2_Counts return CD10002_0.Counts;
815 for T1'Read use Read;
816 for T1'Output use Output;
817 for T1'External_Tag use External_Tag_1;
819 for T2'Write use Write;
820 for T2'Input use Input;
822 type T1 is tagged null record;
824 package T1_Ops is new CD10002_0.Nonlimited_Stream_Ops (T1);
825 package T2_Ops is new CD10002_0.Nonlimited_Stream_Ops (T2);
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)
837 procedure Output (Stream : access Root_Stream_Type'Class; Item : T1)
838 renames T1_Ops.Output;
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)
846 procedure Output (Stream : access Root_Stream_Type'Class; Item : T2)
847 renames T2_Ops.Output;
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;
866 package Deriv renames CD10002_Deriv;
867 generic package Gen renames CD10002_Gen;
868 package Priv renames CD10002_Priv;
870 type Stream_Ops is (Read, Write, Input, Output);
871 type Counts is array (Stream_Ops) of Natural;
873 S : aliased CD10002_1.Dummy_Stream;
877 "Check that operational items are allowed in some contexts " &
878 "where representation items are not");
887 ("Check that the name of an incompletely defined type can be " &
888 "used when specifying an operational item");
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);
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");
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);
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");
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;
926 C10 : R10 (new Integer'(19));
928 package Inst
is new Gen
(T1
=> Character,
934 T7
=> Access_Modular
,
941 X1
: Inst
.Nt1
:= 'a';
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));
952 X11 : Inst.Nt11 := (others => 0);
953 X12 : Inst.Nt12 (D => new Integer'(7));
955 X13
: Inst
.Nt13
:= (others => 0);
958 Comment
("Check that operational items can be specified for a " &
959 "descendant of a generic formal untagged type");
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);
966 if Inst
.Nt1_Ops
.Get_Counts
/= (1, 1, 1, 1) then
968 ("Incorrect calls to the stream attributes for Inst.Nt1");
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);
976 if Inst
.Nt2_Ops
.Get_Counts
/= (1, 1, 1, 1) then
978 ("Incorrect calls to the stream attributes for Inst.Nt2");
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);
986 if Inst
.Nt3_Ops
.Get_Counts
/= (1, 1, 1, 1) then
988 ("Incorrect calls to the stream attributes for Inst.Nt3");
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);
996 if Inst
.Nt4_Ops
.Get_Counts
/= (1, 1, 1, 1) then
998 ("Incorrect calls to the stream attributes for Inst.Nt4");
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);
1006 if Inst
.Nt5_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1008 ("Incorrect calls to the stream attributes for Inst.Nt5");
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);
1016 if Inst
.Nt6_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1018 ("Incorrect calls to the stream attributes for Inst.Nt6");
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);
1026 if Inst
.Nt7_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1028 ("Incorrect calls to the stream attributes for Inst.Nt7");
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);
1036 if Inst
.Nt8_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1038 ("Incorrect calls to the stream attributes for Inst.Nt8");
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);
1046 if Inst
.Nt9_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1048 ("Incorrect calls to the stream attributes for Inst.Nt9");
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;
1056 if Inst
.Get_Nt10_Counts
/= (1, 1, 1, 1) then
1058 ("Incorrect calls to the stream attributes for Inst.Nt10");
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);
1066 if Inst
.Nt11_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1068 ("Incorrect calls to the stream attributes for Inst.Nt11");
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;
1076 if Inst
.Get_Nt12_Counts
/= (1, 1, 1, 1) then
1078 ("Incorrect calls to the stream attributes for Inst.Nt12");
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);
1086 if Inst
.Nt13_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1088 ("Incorrect calls to the stream attributes for Inst.Nt13");
1094 X1
: Deriv
.Nt1
:= Deriv
.False;
1095 X2
: Deriv
.Nt2
:= (others => 0.0);
1096 X3
: Deriv
.Nt3
:= (others => 0.0);
1100 Y5
: System
.Address
;
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 " &
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);
1119 if Deriv
.Nt1_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1121 ("Incorrect calls to the stream attributes for Deriv.Nt1");
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);
1129 if Deriv
.Nt2_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1131 ("Incorrect calls to the stream attributes for Deriv.Nt2");
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);
1139 if Deriv
.Nt3_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1141 ("Incorrect calls to the stream attributes for Deriv.Nt3");
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;
1149 if Deriv
.Nt4_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1151 ("Incorrect calls to the stream attributes for Deriv.Nt4");
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;
1159 if Deriv
.Nt5_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1161 ("Incorrect calls to the stream attributes for Deriv.Nt5");
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;
1169 if Deriv
.Nt6_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1171 ("Incorrect calls to the stream attributes for Deriv.Nt6");
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;
1179 if Deriv
.Nt7_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1181 ("Incorrect calls to the stream attributes for Deriv.Nt7");
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;
1189 if Deriv
.Nt8_Ops
.Get_Counts
/= (1, 1, 1, 1) then
1191 ("Incorrect calls to the stream attributes for Deriv.Nt8");