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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c452001.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C452001.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
--      For a type extension, check that predefined equality is defined in
28
--      terms of the primitive equals operator of the parent type and any
29
--      tagged components of the extension part.
30
--
31
--      For other composite types, check that the primitive equality operator
32
--      of any matching tagged components is used to determine equality of the
33
--      enclosing type.
34
--
35
--      For private types, check that predefined equality is defined in
36
--      terms of the user-defined (primitive) operator of the full type if
37
--      the full type is tagged. The partial view of the type may be
38
--      tagged or untagged. Check that predefined equality for a private
39
--      type whose full view is untagged is defined in terms of the
40
--      predefined equality operator of its full type.
41
--
42
-- TEST DESCRIPTION:
43
--      Tagged types are declared and used as components in several
44
--      differing composite type declarations, both tagged and untagged.
45
--      To differentiate between predefined and primitive equality
46
--      operations, user-defined equality operators are declared for
47
--      each component type that is to contribute to the equality
48
--      operator of the composite type that houses it. All user-defined
49
--      equality operations are designed to yield the opposite result
50
--      from the predefined operator, given the same component values.
51
--
52
--      For cases where primitive equality is to be incorporated into
53
--      equality for the enclosing composite type, values are assigned
54
--      to the component type so that user-defined equality will return
55
--      True. If predefined equality is to be used instead, then the
56
--      same strategy results in the equality operator returning False.
57
--
58
--      When equality for a type incorporates the user-defined equality
59
--      operator of one of its component types, the resulting operator
60
--      is considered to be the predefined operator of the composite type.
61
--      This case is confirmed by defining an tagged component of an
62
--      untagged composite type, then using the resulting untagged type
63
--      as a component of another composite type. The user-defined operator
64
--      for the lowest level should still be called.
65
--
66
--      Three cases are set up to test private types:
67
--
68
--                        Case 1        Case 2      Case 3
69
--         partial view:  tagged       untagged    untagged
70
--         full view:     tagged        tagged     untagged
71
--
72
--      Types are declared for each of the above cases and user-defined
73
--      (primitive) operators are declared following the full type
74
--      declaration of each type (i.e., in the private part).
75
--
76
--      Values are assigned into objects of these types using the same
77
--      strategy outlined above. Cases 1 and 2 should execute the
78
--      user-defined operator. Case 3 should ignore the user-defined
79
--      operator and user predefined equality for the type.
80
--
81
--
82
-- CHANGE HISTORY:
83
--      06 Dec 94   SAIC    ACVC 2.0
84
--      19 Dec 94   SAIC    Removed RM references from objective text.
85
--      15 Nov 95   SAIC    Fixed for 2.0.1
86
--      04 NOV 96   SAIC    Typographical revision
87
--
88
--!
89
 
90
package c452001_0 is
91
 
92
   type Point is
93
      record
94
         X : Integer := 0;
95
         Y : Integer := 0;
96
      end record;
97
 
98
   type Circle is tagged
99
      record
100
         Center : Point;
101
         Radius : Integer;
102
      end record;
103
 
104
   function "=" (L, R : Circle) return Boolean;
105
 
106
   type Colors is (Red, Orange, Yellow, Green, Blue, Purple, Black, White);
107
 
108
   type Colored_Circle is new Circle
109
      with record
110
         Color : Colors := White;
111
      end record;
112
 
113
   function "=" (L, R : Colored_Circle) return Boolean;
114
   -- Override predefined equality for this tagged type. Predefined
115
   -- equality should incorporate user-defined (primitive) equality
116
   -- from type Circle. See C340001 for a test of that feature.
117
 
118
   -- Equality is overridden to ensure that predefined equality
119
   -- incorporates this user-defined function for
120
   -- any composite type with Colored_Circle as a component type.
121
   -- (i.e., the type extension is recognized as a tagged type for
122
   -- the purpose of defining predefined equality for the composite type).
123
 
124
end C452001_0;
125
 
126
package body c452001_0 is
127
 
128
   function "=" (L, R : Circle) return Boolean is
129
   begin
130
      return L.Radius = R.Radius; -- circles are same size
131
   end "=";
132
 
133
   function "=" (L, R : Colored_Circle) return Boolean is
134
   begin
135
      return Circle(L) = Circle(R);
136
   end "=";
137
 
138
end C452001_0;
139
 
140
with C452001_0;
141
package C452001_1 is
142
 
143
   type Planet is tagged record
144
      Name : String (1..15);
145
      Representation : C452001_0.Colored_Circle;
146
   end record;
147
 
148
   -- Type Planet will be used to check that predefined equality
149
   -- for a tagged type with a tagged component incorporates
150
   -- user-defined equality for the component type.
151
 
152
   type TC_Planet is new Planet with null record;
153
 
154
   -- A "copy" of Planet. Used to create a type extension. An "="
155
   -- operator will be defined for this type that should be
156
   -- incorporated by the type extension.
157
 
158
   function "=" (Arg1, Arg2 : in TC_Planet) return Boolean;
159
 
160
   type Craters is array (1..3) of C452001_0.Colored_Circle;
161
 
162
   -- An array type (untagged) with tagged components
163
 
164
   type Moon is new TC_Planet
165
     with record
166
        Crater : Craters;
167
     end record;
168
 
169
   -- A tagged record type. Extended component type is untagged,
170
   -- but its predefined equality operator should incorporate
171
   -- the user-defined operator of its tagged component type.
172
 
173
end C452001_1;
174
 
175
package body C452001_1 is
176
 
177
   function "=" (Arg1, Arg2 : in TC_Planet) return Boolean is
178
   begin
179
      return Arg1.Name = Arg2.Name;
180
   end "=";
181
 
182
end C452001_1;
183
 
184
package C452001_2 is
185
 
186
   -- Untagged record types
187
   -- Equality should not be incorporated
188
 
189
   type Spacecraft_Design is (Mariner, Pioneer, Viking, Voyager);
190
   type Spacecraft is record
191
     Design      : Spacecraft_Design;
192
     Operational : Boolean;
193
   end record;
194
 
195
   function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean;
196
 
197
   type Mission is record
198
      Craft       : Spacecraft;
199
      Launch_Date : Natural;
200
   end record;
201
 
202
   type Inventory is array (Positive range <>) of Spacecraft;
203
 
204
end C452001_2;
205
 
206
package body C452001_2 is
207
 
208
   function "=" (L : in Spacecraft; R : in Spacecraft) return Boolean is
209
   begin
210
      return L.Design = R.Design;
211
   end "=";
212
 
213
end C452001_2;
214
 
215
package C452001_3 is
216
 
217
   type Tagged_Partial_Tagged_Full is tagged private;
218
   procedure Change (Object : in out Tagged_Partial_Tagged_Full;
219
                    Value  : in Boolean);
220
 
221
   type Untagged_Partial_Tagged_Full is private;
222
   procedure Change (Object : in out Untagged_Partial_Tagged_Full;
223
                    Value  : in Integer);
224
 
225
   type Untagged_Partial_Untagged_Full is private;
226
   procedure Change (Object : in out Untagged_Partial_Untagged_Full;
227
                    Value  : in Duration);
228
 
229
private
230
 
231
   type Tagged_Partial_Tagged_Full is
232
      tagged record
233
         B : Boolean := True;
234
         C : Character := ' ';
235
      end record;
236
   -- predefined equality checks that all components are equal
237
 
238
   function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean;
239
   -- primitive equality checks that records equate in component C only
240
 
241
   type Untagged_Partial_Tagged_Full is
242
      tagged record
243
         I : Integer := 0;
244
         P : Positive := 1;
245
      end record;
246
   -- predefined equality checks that all components are equal
247
 
248
   function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean;
249
   -- primitive equality checks that records equate in component P only
250
 
251
   type Untagged_Partial_Untagged_Full is
252
      record
253
         D : Duration := 0.0;
254
         S : String (1..12) := "Ada 9X rules";
255
      end record;
256
   -- predefined equality checks that all components are equal
257
 
258
   function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean;
259
   -- primitive equality checks that records equate in component S only
260
 
261
end C452001_3;
262
 
263
with Report;
264
package body C452001_3 is
265
 
266
   procedure Change (Object : in out Tagged_Partial_Tagged_Full;
267
                    Value  : in Boolean) is
268
   begin
269
      Object := (Report.Ident_Bool(Value), Object.C);
270
   end Change;
271
 
272
   procedure Change (Object : in out Untagged_Partial_Tagged_Full;
273
                    Value  : in Integer) is
274
   begin
275
      Object := (Report.Ident_Int(Value), Object.P);
276
   end Change;
277
 
278
   procedure Change (Object : in out Untagged_Partial_Untagged_Full;
279
                    Value  : in Duration) is
280
   begin
281
      Object := (Value, Report.Ident_Str(Object.S));
282
   end Change;
283
 
284
   function "=" (L, R : in Tagged_Partial_Tagged_Full) return Boolean is
285
   begin
286
      return L.C = R.C;
287
   end "=";
288
 
289
   function "=" (L, R : in Untagged_Partial_Tagged_Full) return Boolean is
290
   begin
291
      return L.P = R.P;
292
   end "=";
293
 
294
   function "=" (L, R : in Untagged_Partial_Untagged_Full) return Boolean is
295
   begin
296
      return R.S = L.S;
297
   end "=";
298
 
299
end C452001_3;
300
 
301
 
302
with C452001_0;
303
with C452001_1;
304
with C452001_2;
305
with C452001_3;
306
with Report;
307
procedure C452001 is
308
 
309
   Mars_Aphelion : C452001_1.Planet :=
310
      (Name           => "Mars           ",
311
       Representation => (Center => (Report.Ident_Int(20),
312
                                     Report.Ident_Int(0)),
313
                          Radius => Report.Ident_Int(4),
314
                          Color  => C452001_0.Red));
315
 
316
   Mars_Perihelion : C452001_1.Planet :=
317
      (Name           => "Mars           ",
318
       Representation => (Center => (Report.Ident_Int(-20),
319
                                     Report.Ident_Int(0)),
320
                          Radius => Report.Ident_Int(4),
321
                          Color  => C452001_0.Red));
322
 
323
   -- Mars_Perihelion = Mars_Aphelion if user-defined equality from
324
   -- the tagged type Colored_Circle was incorporated into
325
   -- predefined equality for the tagged type Planet. User-defined
326
   -- equality for Colored_Circle checks only that the Radii are equal.
327
 
328
   Blue_Mars : C452001_1.Planet :=
329
      (Name           => "Mars           ",
330
       Representation => (Center => (Report.Ident_Int(10),
331
                                     Report.Ident_Int(10)),
332
                          Radius => Report.Ident_Int(4),
333
                          Color  => C452001_0.Blue));
334
 
335
   -- Blue_Mars should equal Mars_Perihelion, because Names and
336
   -- Radii are equal (all other components are not).
337
 
338
   Green_Mars : C452001_1.Planet :=
339
      (Name           => "Mars           ",
340
       Representation => (Center => (Report.Ident_Int(10),
341
                                     Report.Ident_Int(10)),
342
                          Radius => Report.Ident_Int(4),
343
                          Color  => C452001_0.Green));
344
 
345
   -- Blue_Mars should equal Green_Mars. They differ only in the
346
   -- Color component. All user-defined equality operations return
347
   -- True, but records are not equal by predefined equality.
348
 
349
   -- Blue_Mars should equal Mars_Perihelion, because Names and
350
   -- Radii are equal (all other components are not).
351
 
352
   Moon_Craters : C452001_1.Craters :=
353
      ((Center => (Report.Ident_Int(9), Report.Ident_Int(11)),
354
        Radius => Report.Ident_Int(1),
355
        Color  => C452001_0.Black),
356
       (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
357
        Radius => Report.Ident_Int(1),
358
        Color  => C452001_0.Black),
359
       (Center => (Report.Ident_Int(11), Report.Ident_Int(9)),
360
        Radius => Report.Ident_Int(1),
361
        Color  => C452001_0.Black));
362
 
363
   Alternate_Moon_Craters : C452001_1.Craters :=
364
      ((Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
365
        Radius => Report.Ident_Int(1),
366
        Color  => C452001_0.Yellow),
367
       (Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
368
        Radius => Report.Ident_Int(1),
369
        Color  => C452001_0.Purple),
370
       (Center => (Report.Ident_Int(11), Report.Ident_Int(11)),
371
        Radius => Report.Ident_Int(1),
372
        Color  => C452001_0.Purple));
373
 
374
   -- Moon_Craters = Alternate_Moon_Craters if user-defined equality from
375
   -- the tagged type Colored_Circle was incorporated into
376
   -- predefined equality for the untagged type Craters. User-defined
377
   -- equality checks only that the Radii are equal.
378
 
379
   New_Moon : C452001_1.Moon :=
380
      (Name           => "Moon           ",
381
       Representation => (Center => (Report.Ident_Int(10),
382
                                     Report.Ident_Int(8)),
383
                          Radius => Report.Ident_Int(3),
384
                          Color  => C452001_0.Black),
385
       Crater         => Moon_Craters);
386
 
387
   Full_Moon : C452001_1.Moon :=
388
      (Name           => "Moon           ",
389
       Representation => (Center => (Report.Ident_Int(10),
390
                                     Report.Ident_Int(8)),
391
                          Radius => Report.Ident_Int(3),
392
                          Color  => C452001_0.Black),
393
       Crater         => Alternate_Moon_Craters);
394
 
395
   -- New_Moon = Full_Moon if user-defined equality from
396
   -- the tagged type Colored_Circle was incorporated into
397
   -- predefined equality for the untagged type Craters. This
398
   -- equality test should call user-defined equality for type
399
   -- TC_Planet (checks that Names are equal), then predefined
400
   -- equality for Craters (ultimately calls user-defined equality
401
   -- for type Circle, checking that Radii of craters are equal).
402
 
403
   Mars_Moon : C452001_1.Moon :=
404
      (Name           => "Phobos         ",
405
       Representation => (Center => (Report.Ident_Int(10),
406
                                     Report.Ident_Int(8)),
407
                          Radius => Report.Ident_Int(3),
408
                          Color  => C452001_0.Black),
409
       Crater         => Alternate_Moon_Craters);
410
 
411
   -- Mars_Moon /= Full_Moon since the Names differ.
412
 
413
   Alternate_Moon_Craters_2 : C452001_1.Craters :=
414
      ((Center => (Report.Ident_Int(10), Report.Ident_Int(10)),
415
        Radius => Report.Ident_Int(1),
416
        Color  => C452001_0.Red),
417
       (Center => (Report.Ident_Int(9), Report.Ident_Int(9)),
418
        Radius => Report.Ident_Int(1),
419
        Color  => C452001_0.Red),
420
       (Center => (Report.Ident_Int(10), Report.Ident_Int(9)),
421
        Radius => Report.Ident_Int(1),
422
        Color  => C452001_0.Red));
423
 
424
   Harvest_Moon : C452001_1.Moon :=
425
      (Name           => "Moon           ",
426
       Representation => (Center => (Report.Ident_Int(11),
427
                                     Report.Ident_Int(7)),
428
                          Radius => Report.Ident_Int(4),
429
                          Color  => C452001_0.Orange),
430
       Crater         => Alternate_Moon_Craters_2);
431
 
432
   -- Only the fields that are employed by the user-defined equality
433
   -- operators are the same. Everything else differs. Equality should
434
   -- still return True.
435
 
436
   Viking_1_Orbiter : C452001_2.Mission :=
437
      (Craft => (Design      => C452001_2.Viking,
438
                 Operational => Report.Ident_Bool(False)),
439
       Launch_Date => 1975);
440
 
441
   Viking_1_Lander : C452001_2.Mission :=
442
      (Craft => (Design      => C452001_2.Viking,
443
                 Operational => Report.Ident_Bool(True)),
444
       Launch_Date => 1975);
445
 
446
   -- Viking_1_Orbiter /= Viking_1_Lander if predefined equality
447
   -- from the untagged type Spacecraft is used for equality
448
   -- of matching components in type Mission. If user-defined
449
   -- equality for type Spacecraft is incorporated, which it
450
   -- should not be by 4.5.2(21), then Viking_1_Orbiter = Viking_1_Lander.
451
 
452
   Voyagers : C452001_2.Inventory (1..2):=
453
    ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
454
     (C452001_2.Voyager, Operational => Report.Ident_Bool(False)));
455
 
456
   Jupiter_Craft : C452001_2.Inventory (1..2):=
457
    ((C452001_2.Voyager, Operational => Report.Ident_Bool(True)),
458
     (C452001_2.Voyager, Operational => Report.Ident_Bool(True)));
459
 
460
   -- Voyagers /= Jupiter_Craft if predefined equality
461
   -- from the untagged type Spacecraft is used for equality
462
   -- of matching components in type Inventory. If user-defined
463
   -- equality for type Spacecraft is incorporated, which it
464
   -- should not be by 4.5.2(21), then Voyagers = Jupiter_Craft.
465
 
466
   TPTF_1 : C452001_3.Tagged_Partial_Tagged_Full;
467
   TPTF_2 : C452001_3.Tagged_Partial_Tagged_Full;
468
 
469
   -- With differing values for Boolean component, user-defined
470
   -- (primitive) equality returns True, predefined equality
471
   -- returns False. Since full type is tagged, primitive equality
472
   -- should be used.
473
 
474
   UPTF_1 : C452001_3.Untagged_Partial_Tagged_Full;
475
   UPTF_2 : C452001_3.Untagged_Partial_Tagged_Full;
476
 
477
   -- With differing values for Boolean component, user-defined
478
   -- (primitive) equality returns True, predefined equality
479
   -- returns False. Since full type is tagged, primitive equality
480
   -- should be used.
481
 
482
   UPUF_1 : C452001_3.Untagged_Partial_Untagged_Full;
483
   UPUF_2 : C452001_3.Untagged_Partial_Untagged_Full;
484
 
485
   -- With differing values for Duration component, user-defined
486
   -- (primitive) equality returns True, predefined equality
487
   -- returns False. Since full type is untagged, predefined equality
488
   -- should be used.
489
 
490
   -- Use type clauses make "=" and "/=" operators directly visible
491
   use type C452001_1.Planet;
492
   use type C452001_1.Craters;
493
   use type C452001_1.Moon;
494
   use type C452001_2.Mission;
495
   use type C452001_2.Inventory;
496
   use type C452001_3.Tagged_Partial_Tagged_Full;
497
   use type C452001_3.Untagged_Partial_Tagged_Full;
498
   use type C452001_3.Untagged_Partial_Untagged_Full;
499
 
500
begin
501
 
502
   Report.Test ("C452001", "Equality of private types and " &
503
                           "composite types with tagged components");
504
 
505
   -------------------------------------------------------------------
506
   -- Tagged type with tagged component.
507
   -------------------------------------------------------------------
508
 
509
   if not (Mars_Aphelion = Mars_Perihelion) then
510
      Report.Failed ("User-defined equality for tagged component " &
511
                     "was not incorporated into predefined equality " &
512
                     "for enclosing tagged record type");
513
   end if;
514
 
515
   if Mars_Aphelion /= Mars_Perihelion then
516
      Report.Failed ("User-defined equality for tagged component " &
517
                     "was not incorporated into predefined inequality " &
518
                     "for enclosing tagged record type");
519
   end if;
520
 
521
   if not (Blue_Mars = Mars_Perihelion) then
522
      Report.Failed ("Equality test for tagged record type " &
523
                     "incorporates record components " &
524
                     "other than those used by user-defined equality");
525
   end if;
526
 
527
   if Blue_Mars /= Mars_Perihelion then
528
      Report.Failed ("Inequality test for tagged record type " &
529
                     "incorporates record components " &
530
                     "other than those used by user-defined equality");
531
   end if;
532
 
533
   if Blue_Mars /= Green_Mars then
534
      Report.Failed ("Records are unequal even though they only differ " &
535
                     "in a component not used by user-defined equality");
536
   end if;
537
 
538
   if not (Blue_Mars = Green_Mars) then
539
      Report.Failed ("Records are not equal even though they only differ " &
540
                     "in a component not used by user-defined equality");
541
   end if;
542
 
543
   -------------------------------------------------------------------
544
   -- Untagged (array) type with tagged component.
545
   -------------------------------------------------------------------
546
 
547
   if not (Moon_Craters = Alternate_Moon_Craters) then
548
      Report.Failed ("User-defined equality for tagged component " &
549
                     "was not incorporated into predefined equality " &
550
                     "for enclosing array type");
551
   end if;
552
 
553
   if Moon_Craters /= Alternate_Moon_Craters then
554
      Report.Failed ("User-defined equality for tagged component " &
555
                     "was not incorporated into predefined inequality " &
556
                     "for enclosing array type");
557
   end if;
558
 
559
   -------------------------------------------------------------------
560
   -- Tagged type with untagged composite component. Untagged
561
   -- component itself has tagged components.
562
   -------------------------------------------------------------------
563
   if not (New_Moon = Full_Moon) then
564
      Report.Failed ("User-defined equality for tagged component " &
565
                     "was not incorporated into predefined equality " &
566
                     "for array component of tagged record type");
567
   end if;
568
 
569
   if New_Moon /= Full_Moon then
570
      Report.Failed ("User-defined equality for tagged component " &
571
                     "was not incorporated into predefined inequality " &
572
                     "for array component of tagged record type");
573
   end if;
574
 
575
   if Mars_Moon = Full_Moon then
576
      Report.Failed ("User-defined equality for tagged component " &
577
                     "was not incorporated into predefined equality " &
578
                     "for array component of tagged record type");
579
   end if;
580
 
581
   if not (Mars_Moon /= Full_Moon) then
582
      Report.Failed ("User-defined equality for tagged component " &
583
                     "was not incorporated into predefined inequality " &
584
                     "for array component of tagged record type");
585
   end if;
586
 
587
   if not (Harvest_Moon = Full_Moon) then
588
      Report.Failed ("Equality test for record with array of tagged " &
589
                     "components incorporates record components " &
590
                     "other than those used by user-defined equality");
591
   end if;
592
 
593
   if Harvest_Moon /= Full_Moon then
594
      Report.Failed ("Inequality test for record with array of tagged " &
595
                     "components incorporates record components " &
596
                     "other than those used by user-defined equality");
597
   end if;
598
 
599
   -------------------------------------------------------------------
600
   -- Untagged types with no tagged components.
601
   -------------------------------------------------------------------
602
 
603
   -- Record type
604
 
605
   if Viking_1_Orbiter = Viking_1_Lander then
606
      Report.Failed ("User-defined equality for untagged composite " &
607
                     "component was incorporated into predefined " &
608
                     "equality for " &
609
                     "untagged record type");
610
   end if;
611
 
612
   if not (Viking_1_Orbiter /= Viking_1_Lander) then
613
      Report.Failed ("User-defined equality for untagged composite " &
614
                     "component was incorporated into predefined " &
615
                     "inequality for " &
616
                     "untagged record type");
617
   end if;
618
 
619
   -- Array type
620
 
621
   if Voyagers = Jupiter_Craft then
622
      Report.Failed ("User-defined equality for untagged composite " &
623
                     "component was incorporated into predefined " &
624
                     "equality for " &
625
                     "array type");
626
   end if;
627
 
628
   if not (Voyagers /= Jupiter_Craft) then
629
      Report.Failed ("User-defined equality for untagged composite " &
630
                     "component was incorporated into predefined " &
631
                     "inequality for " &
632
                     "array type");
633
   end if;
634
 
635
   -------------------------------------------------------------------
636
   -- Private types tests.
637
   -------------------------------------------------------------------
638
 
639
   -- Make objects differ from one another
640
 
641
   C452001_3.Change (TPTF_1, False);
642
   C452001_3.Change (UPTF_1, 999);
643
   C452001_3.Change (UPUF_1, 40.0);
644
 
645
   -------------------------------------------------------------------
646
   -- Partial type and full type are tagged. (Full type must be tagged
647
   -- if partial type is tagged)
648
   -------------------------------------------------------------------
649
 
650
   if not (TPTF_1 = TPTF_2) then
651
      Report.Failed ("Predefined equality for full type " &
652
                     "was used to determine equality of " &
653
                     "tagged private type " &
654
                     "instead of user-defined (primitive) equality");
655
   end if;
656
 
657
   if TPTF_1 /= TPTF_2 then
658
      Report.Failed ("Predefined equality for full type " &
659
                     "was used to determine inequality of " &
660
                     "tagged private type " &
661
                     "instead of user-defined (primitive) equality");
662
   end if;
663
 
664
   -------------------------------------------------------------------
665
   -- Partial type untagged, full type tagged.
666
   -------------------------------------------------------------------
667
 
668
   if not (UPTF_1 = UPTF_2) then
669
      Report.Failed ("Predefined equality for full type " &
670
                     "was used to determine equality of " &
671
                     "private type (untagged partial view, " &
672
                     "tagged full view) " &
673
                     "instead of user-defined (primitive) equality");
674
   end if;
675
 
676
   if UPTF_1 /= UPTF_2 then
677
      Report.Failed ("Predefined equality for full type " &
678
                     "was used to determine inequality of " &
679
                     "private type (untagged partial view, " &
680
                     "tagged full view) " &
681
                     "instead of user-defined (primitive) equality");
682
   end if;
683
 
684
   -------------------------------------------------------------------
685
   -- Partial type and full type are both untagged.
686
   -------------------------------------------------------------------
687
 
688
   if UPUF_1 = UPUF_2 then
689
      Report.Failed ("User-defined (primitive) equality for full type " &
690
                     "was used to determine equality of " &
691
                     "private type (untagged partial view, " &
692
                     "untagged full view) " &
693
                     "instead of predefined equality");
694
   end if;
695
 
696
   if not (UPUF_1 /= UPUF_2) then
697
      Report.Failed ("User-defined (primitive) equality for full type " &
698
                     "was used to determine inequality of " &
699
                     "private type (untagged partial view, " &
700
                     "untagged full view) " &
701
                     "instead of predefined equality");
702
   end if;
703
 
704
   -------------------------------------------------------------------
705
   Report.Result;
706
 
707
end C452001;

powered by: WebSVN 2.1.0

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