OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cd10002.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- 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
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.