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--! 48with Ada.Streams; 49use Ada.Streams; 50package 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 82end CD10002_0; 83 84 85package 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 153end CD10002_0; 154 155 156with Ada.Streams; 157use Ada.Streams; 158package 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 167end CD10002_1; 168 169 170with Report; 171use Report; 172package 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 187end CD10002_1; 188 189 190with Ada.Streams; 191use Ada.Streams; 192with CD10002_0; 193package 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 334end CD10002_Deriv; 335 336 337package 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 430end CD10002_Deriv; 431 432 433with Ada.Streams; 434use Ada.Streams; 435with CD10002_0; 436generic 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; 449package 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 623end CD10002_Gen; 624 625 626package 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 776end CD10002_Gen; 777 778 779with Ada.Streams; 780use Ada.Streams; 781with CD10002_0; 782package 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 813private 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 827end CD10002_Priv; 828 829 830package 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; 851end CD10002_Priv; 852 853 854with Ada.Streams; 855use Ada.Streams; 856with Report; 857use Report; 858with System; 859with CD10002_0; 860with CD10002_1; 861with CD10002_Deriv; 862with CD10002_Gen; 863with CD10002_Priv; 864procedure 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 875begin 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; 1196end CD10002; 1197 1198 1199