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/] [ca/] [ca11c02.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CA11C02.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
--      Check that primitive operations declared in a child package
28
--      override operations declared in ancestor packages, and that
29
--      operations on class-wide types defined in the ancestor packages
30
--      dispatch as appropriate to these overriding implementations.
31
--
32
-- TEST DESCRIPTION:
33
--
34
--      This test builds on the foundation code file (FA11C00) that contains
35
--      a parent package, child package, and grandchild package.  The parent
36
--      package declares a tagged type and primitive operation.  The child
37
--      package extends the type, and overrides the primitive operation. The
38
--      grandchild package does the same.
39
--
40
--      The test procedure "withs" the grandchild package, and receives
41
--      visibility to all of its ancestor packages, types and operations.
42
--      A procedure with a formal class-wide parameter is defined that will
43
--      allow for dispatching calls to the overridden primitive operations,
44
--      based on the specific type of the actual parameter.  The primitive
45
--      operations provide a string value to update a global string array
46
--      variable.  Calls to the local procedure are made, with objects of each
47
--      of the tagged types as parameters, and the global variable is finally
48
--      examined to ensure that the correct version of primitive operation was
49
--      dispatched correctly.
50
--
51
-- TEST FILES:
52
--      This test depends on the following foundation code:
53
--
54
--         FA11C00.A
55
--
56
--
57
-- CHANGE HISTORY:
58
--      06 Dec 94   SAIC    ACVC 2.0
59
--
60
--!
61
 
62
with FA11C00_0.FA11C00_1.FA11C00_2;    -- Package Animal.Mammal.Primate
63
with Report;
64
 
65
procedure CA11C02 is
66
 
67
   package Animal_Package  renames FA11C00_0;
68
   package Mammal_Package  renames FA11C00_0.FA11C00_1;
69
   package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2;
70
 
71
   Max_Animals : constant := 3;
72
 
73
   type Data_Base_Type is array (1 .. Max_Animals) of String (1 .. 37);
74
 
75
   Zoo_Data_Base : Data_Base_Type := (others => (others => ' '));
76
                                      -- Global variable.
77
 
78
   Macaw : Animal_Package.Animal   := (Common_Name => "Scarlet Macaw       ",
79
                                       Weight      => 2);
80
 
81
   Manatee : Mammal_Package.Mammal := (Common_Name => "Southern Manatee    ",
82
                                       Weight      => 230,
83
                                       Hair_Color  => Mammal_Package.Brown);
84
 
85
   Lemur : Primate_Package.Primate :=
86
              (Common_Name => "Ring-Tailed Lemur   ",
87
               Weight      => 5,
88
               Hair_Color  => Mammal_Package.Black,
89
               Habitat     => Primate_Package.Arboreal);
90
begin
91
 
92
   Report.Test ("CA11C02", "Check that primitive operations declared "   &
93
                           "in a child package override operations declared " &
94
                           "in ancestor packages, and that operations " &
95
                           "on class-wide types defined in the ancestor " &
96
                           "packages dispatch as appropriate to these " &
97
                           "overriding implementations");
98
 
99
   declare
100
 
101
      use Animal_Package, Mammal_Package, Primate_Package;
102
 
103
      -- The following procedure updates the global variable Zoo_Data_Base.
104
 
105
      procedure Enter_Data (A : Animal'Class; I : Integer) is
106
      begin
107
         Zoo_Data_Base (I) := Image (A);
108
      end Enter_Data;
109
 
110
   begin
111
 
112
      -- Verify initial test conditions.
113
 
114
      if not (Zoo_Data_Base(1)(1..6) = "      ")
115
         or not
116
             (Zoo_Data_Base(2)(1..6) = "      ")
117
         or not
118
             (Zoo_Data_Base(3)(1..6) = "      ")
119
      then
120
         Report.Failed ("Initial condition failure");
121
      end if;
122
 
123
 
124
      -- Enter data from all three animals into the zoo database.
125
 
126
      Enter_Data (Macaw, 1);                 -- First entry in database.
127
      Enter_Data (A => Manatee, I => 2);     -- Second entry.
128
      Enter_Data (Lemur, I => 3);            -- Third entry.
129
 
130
      -- Verify the correct version of the overridden function Image was used
131
      -- for entering the specific data.
132
 
133
      if not (Zoo_Data_Base(1)(1 .. 6)   = "Animal")
134
        or not
135
             (Zoo_Data_Base(1)(26 .. 30) = "Macaw")
136
        then
137
           Report.Failed ("Incorrect version of Image for parent type");
138
      end if;
139
 
140
      if not (Zoo_Data_Base(2)(1 .. 6)   = "Mammal"
141
        and
142
          Zoo_Data_Base(2)(27 .. 33) = "Manatee")
143
        then
144
           Report.Failed ("Incorrect version of Image for child type");
145
      end if;
146
 
147
      if not ((Zoo_Data_Base(3)(1 .. 7)   = "Primate")
148
        and
149
          (Zoo_Data_Base(3)(30 .. 34) = "Lemur"))
150
        then
151
           Report.Failed ("Incorrect version of Image for grandchild type");
152
      end if;
153
 
154
   end;
155
 
156
   Report.Result;
157
 
158
end CA11C02;

powered by: WebSVN 2.1.0

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