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/] [c4/] [c432001.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C432001.A
2
--
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7
--     unlimited rights in the software and documentation contained herein.
8
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
9
--     this public release, the Government intends to confer upon all
10
--     recipients unlimited rights  equal to those held by the Government.
11
--     These rights include rights to use, duplicate, release or disclose the
12
--     released technical data and computer software in whole or in part, in
13
--     any manner and for any purpose whatsoever, and to have or permit others
14
--     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
--
28
--      Check that extension aggregates may be used to specify values
29
--      for types that are record extensions. Check that the
30
--      type of the ancestor expression may be any nonlimited type that
31
--      is a record extension, including private types and private
32
--      extensions. Check that the type for the aggregate is
33
--      derived from the type of the ancestor expression.
34
--
35
-- TEST DESCRIPTION:
36
--
37
--      Two progenitor nonlimited record types are declared, one
38
--      nonprivate and one private. Using these as parent types,
39
--      all possible combinations of record extensions are declared
40
--      (Nonprivate record extension of nonprivate type, private
41
--      extension of nonprivate type, nonprivate record extension of
42
--      private type, and private extension of private type). Finally,
43
--      each of these types is extended using nonprivate record
44
--      extensions.
45
--
46
--      Extension of private types is done in packages other than
47
--      the ones containing the parent declaration. This is done
48
--      to eliminate errors with extension of the partial view of
49
--      a type, which is not an objective of this test.
50
--
51
--      All components of private types and private extensions are given
52
--      default values. This eliminates the need for separate subprograms
53
--      whose sole purpose is to place a value into a private record type.
54
--
55
--      Types that have been extended are checked using an object of their
56
--      parent type as the ancestor expression. For those types that
57
--      have been extended twice, using only nonprivate record extensions,
58
--      a check is made using an object of their grandparent type as
59
--      the ancestor expression.
60
--
61
--      For each type, a subprogram is defined which checks the contents
62
--      of the parameter, which is a value of the record extension.
63
--      Components of nonprivate record extensions are checked against
64
--      passed-in parameters of the component type. Components of private
65
--      extensions are checked to ensure that they maintain their initial
66
--      values.
67
--
68
--      To check that the aggregate's type is derived from its ancestor,
69
--      each Check subprogram in turn calls the Check subprogram for
70
--      its parent type. Explicit conversion is used to convert the
71
--      record extension to the parent type.
72
--
73
--
74
-- CHANGE HISTORY:
75
--      06 Dec 94   SAIC    ACVC 2.0
76
--
77
--!
78
 
79
with Report;
80
package C432001_0 is
81
 
82
   type Eras is (Precambrian, Paleozoic, Mesozoic, Cenozoic);
83
 
84
   type N is tagged record
85
      How_Long_Ago : Natural := Report.Ident_Int(1);
86
      Era          : Eras := Cenozoic;
87
   end record;
88
 
89
   function Check (Rec : in N;
90
                   N   : in Natural;
91
                   E   : in Eras) return Boolean;
92
 
93
   type P is tagged private;
94
 
95
   function Check (Rec : in P) return Boolean;
96
 
97
private
98
 
99
   type P is tagged record
100
      How_Long_Ago : Natural := Report.Ident_Int(150);
101
      Era          : Eras := Mesozoic;
102
   end record;
103
 
104
end C432001_0;
105
 
106
package body C432001_0 is
107
 
108
   function Check (Rec : in P) return Boolean is
109
   begin
110
      return Rec.How_Long_Ago = 150 and Rec.Era = Mesozoic;
111
   end Check;
112
 
113
   function Check (Rec : in N;
114
                   N   : in Natural;
115
                   E   : in Eras) return Boolean is
116
   begin
117
      return Rec.How_Long_Ago = N and Rec.Era = E;
118
   end Check;
119
 
120
end C432001_0;
121
 
122
with C432001_0;
123
package C432001_1 is
124
 
125
   type Periods is
126
      (Aphebian, Helikian, Hadrynian,
127
       Cambrian, Ordovician, Silurian, Devonian, Carboniferous, Permian,
128
       Triassic, Jurassic, Cretaceous,
129
       Tertiary, Quaternary);
130
 
131
   type N_N is new C432001_0.N with record
132
      Period : Periods := C432001_1.Quaternary;
133
   end record;
134
 
135
   function Check (Rec : in N_N;
136
                   N   : in Natural;
137
                   E   : in C432001_0.Eras;
138
                   P   : in Periods) return Boolean;
139
 
140
   type N_P is new C432001_0.N with private;
141
 
142
   function Check (Rec : in N_P) return Boolean;
143
 
144
   type P_N is new C432001_0.P with record
145
      Period : Periods := C432001_1.Jurassic;
146
   end record;
147
 
148
   function Check (Rec : in P_N;
149
                   P   : in Periods) return Boolean;
150
 
151
   type P_P is new C432001_0.P with private;
152
 
153
   function Check (Rec : in P_P) return Boolean;
154
 
155
   type P_P_Null is new C432001_0.P with null record;
156
 
157
private
158
 
159
   type N_P is new C432001_0.N with record
160
      Period : Periods := C432001_1.Quaternary;
161
   end record;
162
 
163
   type P_P is new C432001_0.P with record
164
      Period : Periods := C432001_1.Jurassic;
165
   end record;
166
 
167
end C432001_1;
168
 
169
with Report;
170
package body C432001_1 is
171
 
172
   function Check (Rec : in N_N;
173
                   N   : in Natural;
174
                   E   : in C432001_0.Eras;
175
                   P   : in Periods) return Boolean is
176
   begin
177
      if not C432001_0.Check (C432001_0.N (Rec), N, E) then
178
         Report.Failed ("Conversion to parent type of " &
179
                        "nonprivate portion of " &
180
                        "nonprivate extension failed");
181
      end if;
182
      return Rec.Period = P;
183
   end Check;
184
 
185
 
186
   function Check (Rec : in N_P) return Boolean is
187
   begin
188
      if not C432001_0.Check (C432001_0.N (Rec), 1, C432001_0.Cenozoic) then
189
         Report.Failed ("Conversion to parent type of " &
190
                        "nonprivate portion of " &
191
                        "private extension failed");
192
      end if;
193
      return Rec.Period = C432001_1.Quaternary;
194
   end Check;
195
 
196
   function Check (Rec : in P_N;
197
                   P   : in Periods) return Boolean is
198
   begin
199
      if not C432001_0.Check (C432001_0.P (Rec)) then
200
         Report.Failed ("Conversion to parent type of " &
201
                        "private portion of " &
202
                        "nonprivate extension failed");
203
      end if;
204
      return Rec.Period = P;
205
   end Check;
206
 
207
   function Check (Rec : in P_P) return Boolean is
208
   begin
209
      if not C432001_0.Check (C432001_0.P (Rec)) then
210
         Report.Failed ("Conversion to parent type of " &
211
                        "private portion of " &
212
                        "private extension failed");
213
      end if;
214
      return Rec.Period = C432001_1.Jurassic;
215
   end Check;
216
 
217
end C432001_1;
218
 
219
with C432001_0;
220
with C432001_1;
221
package C432001_2 is
222
 
223
   -- All types herein are nonprivate extensions, since aggregates
224
   -- cannot be given for private extensions
225
 
226
   type N_N_N is new C432001_1.N_N with record
227
      Sample_On_Loan : Boolean;
228
   end record;
229
 
230
   function Check (Rec : in N_N_N;
231
                   N   : in Natural;
232
                   E   : in C432001_0.Eras;
233
                   P   : in C432001_1.Periods;
234
                   B   : in Boolean) return Boolean;
235
 
236
   type N_P_N is new C432001_1.N_P with record
237
      Sample_On_Loan : Boolean;
238
   end record;
239
 
240
   function Check (Rec : in N_P_N;
241
                   B   : Boolean) return Boolean;
242
 
243
   type P_N_N is new C432001_1.P_N with record
244
      Sample_On_Loan : Boolean;
245
   end record;
246
 
247
   function Check (Rec : in P_N_N;
248
                   P   : in C432001_1.Periods;
249
                   B   : Boolean) return Boolean;
250
 
251
   type P_P_N is new C432001_1.P_P with record
252
      Sample_On_Loan : Boolean;
253
   end record;
254
 
255
   function Check (Rec : in P_P_N;
256
                   B   : Boolean) return Boolean;
257
 
258
end C432001_2;
259
 
260
with Report;
261
package body C432001_2 is
262
 
263
   -- direct access to operator
264
   use type C432001_1.Periods;
265
 
266
 
267
   function Check (Rec : in N_N_N;
268
                   N   : in Natural;
269
                   E   : in C432001_0.Eras;
270
                   P   : in C432001_1.Periods;
271
                   B   : in Boolean) return Boolean is
272
   begin
273
      if not C432001_1.Check (C432001_1.N_N (Rec), N, E, P) then
274
         Report.Failed ("Conversion to parent " &
275
                        "nonprivate type extension " &
276
                        "failed");
277
      end if;
278
      return Rec.Sample_On_Loan = B;
279
   end Check;
280
 
281
 
282
   function Check (Rec : in N_P_N;
283
                   B   : Boolean) return Boolean is
284
   begin
285
      if not C432001_1.Check (C432001_1.N_P (Rec)) then
286
         Report.Failed ("Conversion to parent " &
287
                        "private type extension " &
288
                        "failed");
289
      end if;
290
      return Rec.Sample_On_Loan = B;
291
   end Check;
292
 
293
   function Check (Rec : in P_N_N;
294
                   P   : in C432001_1.Periods;
295
                   B   : Boolean) return Boolean is
296
   begin
297
      if not C432001_1.Check (C432001_1.P_N (Rec), P) then
298
         Report.Failed ("Conversion to parent " &
299
                        "nonprivate type extension " &
300
                        "failed");
301
      end if;
302
      return Rec.Sample_On_Loan = B;
303
   end Check;
304
 
305
   function Check (Rec : in P_P_N;
306
                   B   : Boolean) return Boolean is
307
   begin
308
      if not C432001_1.Check (C432001_1.P_P (Rec)) then
309
         Report.Failed ("Conversion to parent " &
310
                        "private type extension " &
311
                        "failed");
312
      end if;
313
      return Rec.Sample_On_Loan = B;
314
   end Check;
315
 
316
end C432001_2;
317
 
318
 
319
with C432001_0;
320
with C432001_1;
321
with C432001_2;
322
with Report;
323
procedure C432001 is
324
 
325
   N_Object : C432001_0.N := (How_Long_Ago => Report.Ident_Int(375),
326
                              Era          => C432001_0.Paleozoic);
327
 
328
   P_Object : C432001_0.P; -- default value is (150,
329
                           --                   C432001_0.Mesozoic)
330
 
331
   N_N_Object : C432001_1.N_N :=
332
      (N_Object with Period => C432001_1.Devonian);
333
 
334
   P_N_Object : C432001_1.P_N :=
335
      (P_Object with Period => C432001_1.Jurassic);
336
 
337
   N_P_Object : C432001_1.N_P; -- default is (1,
338
                               --             C432001_0.Cenozoic,
339
                               --             C432001_1.Quaternary)
340
 
341
   P_P_Object : C432001_1.P_P; -- default is (150,
342
                               --             C432001_0.Mesozoic,
343
                               --             C432001_1.Jurassic)
344
 
345
   P_P_Null_Ob:C432001_1.P_P_Null := (P_Object with null record);
346
 
347
   N_N_N_Object : C432001_2.N_N_N :=
348
      (N_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
349
 
350
   N_P_N_Object : C432001_2.N_P_N :=
351
      (N_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
352
 
353
   P_N_N_Object : C432001_2.P_N_N :=
354
      (P_N_Object with Sample_On_Loan => Report.Ident_Bool(True));
355
 
356
   P_P_N_Object : C432001_2.P_P_N :=
357
      (P_P_Object with Sample_On_Loan => Report.Ident_Bool(False));
358
 
359
   P_N_Object_2 : C432001_1.P_N := (C432001_0.P(P_N_N_Object)
360
                                    with C432001_1.Carboniferous);
361
 
362
   N_N_Object_2 : C432001_1.N_N := (C432001_0.N'(42,C432001_0.Precambrian)
363
                                    with C432001_1.Carboniferous);
364
 
365
begin
366
 
367
   Report.Test ("C432001", "Extension aggregates");
368
 
369
   -- check ultimate ancestor types
370
 
371
   if not C432001_0.Check (N_Object,
372
                           375,
373
                           C432001_0.Paleozoic) then
374
      Report.Failed ("Object of " &
375
                     "nonprivate type " &
376
                     "failed content check");
377
   end if;
378
 
379
   if not C432001_0.Check (P_Object) then
380
      Report.Failed ("Object of " &
381
                     "private type " &
382
                     "failed content check");
383
   end if;
384
 
385
   -- check direct type extensions
386
 
387
   if not C432001_1.Check (N_N_Object,
388
                           375,
389
                           C432001_0.Paleozoic,
390
                           C432001_1.Devonian) then
391
      Report.Failed ("Object of " &
392
                     "nonprivate extension of nonprivate type " &
393
                     "failed content check");
394
   end if;
395
 
396
   if not C432001_1.Check (N_P_Object) then
397
      Report.Failed ("Object of " &
398
                     "private extension of nonprivate type " &
399
                     "failed content check");
400
   end if;
401
 
402
   if not C432001_1.Check (P_N_Object,
403
                           C432001_1.Jurassic) then
404
      Report.Failed ("Object of " &
405
                     "nonprivate extension of private type " &
406
                     "failed content check");
407
   end if;
408
 
409
   if not C432001_1.Check (P_P_Object) then
410
      Report.Failed ("Object of " &
411
                     "private extension of private type " &
412
                     "failed content check");
413
   end if;
414
 
415
    if not C432001_1.Check (P_P_Null_Ob) then
416
      Report.Failed ("Object of " &
417
                     "private type " &
418
                     "failed content check");
419
   end if;
420
 
421
 
422
   -- check direct extensions of extensions
423
 
424
   if not C432001_2.Check (N_N_N_Object,
425
                           375,
426
                           C432001_0.Paleozoic,
427
                           C432001_1.Devonian,
428
                           True) then
429
      Report.Failed ("Object of " &
430
                     "nonprivate extension of nonprivate extension " &
431
                     "(of nonprivate parent) " &
432
                     "failed content check");
433
   end if;
434
 
435
   if not C432001_2.Check (N_P_N_Object, False) then
436
      Report.Failed ("Object of " &
437
                     "nonprivate extension of private extension " &
438
                     "(of nonprivate parent) " &
439
                     "failed content check");
440
   end if;
441
 
442
   if not C432001_2.Check (P_N_N_Object,
443
                           C432001_1.Jurassic,
444
                           True) then
445
      Report.Failed ("Object of " &
446
                     "nonprivate extension of nonprivate extension " &
447
                     "(of private parent) " &
448
                     "failed content check");
449
   end if;
450
 
451
   if not C432001_2.Check (P_P_N_Object, False) then
452
      Report.Failed ("Object of " &
453
                     "nonprivate extension of private extension " &
454
                     "(of private parent) " &
455
                     "failed content check");
456
   end if;
457
 
458
   -- check that the extension aggregate may specify an expression of
459
   -- a "grandparent" ancestor type
460
 
461
   -- types tested are derived through nonprivate extensions only
462
   -- (extension aggregates are not allowed if the path from the
463
   -- ancestor type wanders through a private extension)
464
 
465
   N_N_N_Object :=
466
      (N_Object with Period => C432001_1.Devonian,
467
                     Sample_On_Loan => Report.Ident_Bool(True));
468
 
469
   if not C432001_2.Check (N_N_N_Object,
470
                           375,
471
                           C432001_0.Paleozoic,
472
                           C432001_1.Devonian,
473
                           True) then
474
      Report.Failed ("Object of " &
475
                     "nonprivate extension " &
476
                     "of nonprivate ancestor " &
477
                     "failed content check");
478
   end if;
479
 
480
   P_N_N_Object :=
481
      (P_Object with Period => C432001_1.Jurassic,
482
                     Sample_On_Loan => Report.Ident_Bool(True));
483
 
484
   if not C432001_2.Check (P_N_N_Object,
485
                           C432001_1.Jurassic,
486
                           True) then
487
      Report.Failed ("Object of " &
488
                     "nonprivate extension " &
489
                     "of private ancestor " &
490
                     "failed content check");
491
   end if;
492
 
493
  -- Check additional cases
494
   if not C432001_1.Check (P_N_Object_2,
495
                           C432001_1.Carboniferous) then
496
      Report.Failed ("Additional Object of " &
497
                     "nonprivate extension of private type " &
498
                     "failed content check");
499
   end if;
500
 
501
   if not C432001_1.Check (N_N_Object_2,
502
                           42,
503
                           C432001_0.Precambrian,
504
                           C432001_1.Carboniferous) then
505
      Report.Failed ("Additional Object of " &
506
                     "nonprivate extension of nonprivate type " &
507
                     "failed content check");
508
   end if;
509
 
510
   Report.Result;
511
 
512
end C432001;

powered by: WebSVN 2.1.0

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