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