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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C393A02.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 a dispatching call to an abstract subprogram invokes
28
--     the correct subprogram body of a descendant type according to
29
--     the controlling tag.
30
--     Check that a subprogram can be declared with formal parameters
31
--     and result that are of an abstract type's associated class-wide
32
--     type and that such subprograms can be called. 3.4.1(4)
33
--
34
-- TEST DESCRIPTION:
35
--     This test declares several objects of types derived from the
36
--     abstract type as defined in the foundation F393A00.  It then calls
37
--     various dispatching and class-wide subprograms using those objects.
38
--     The packages in F393A00 are instrumented to trace the flow of
39
--     execution.
40
--     The test checks for the correct order of execution, as expected
41
--     by the various calls.
42
--
43
-- TEST FILES:
44
--     The following files comprise this test:
45
--
46
--        F393A00.A   (foundation code)
47
--        C393A02.A
48
--
49
--
50
-- CHANGE HISTORY:
51
--      06 Dec 94   SAIC    ACVC 2.0
52
--      19 Dec 94   SAIC    Removed RM references from objective text.
53
--      05 APR 96   SAIC    Update RM references for 2.1
54
--
55
--!
56
 
57
with Report;
58
with F393A00_0;
59
with F393A00_1;
60
with F393A00_2;
61
with F393A00_3;
62
with F393A00_4;
63
procedure C393A02 is
64
 
65
  A_Windmill : F393A00_2.Windmill;
66
  A_Pump     : F393A00_3.Pump;
67
  A_Mill     : F393A00_4.Mill;
68
 
69
  A_Windmill_2 : F393A00_2.Windmill;
70
  A_Pump_2     : F393A00_3.Pump;
71
  A_Mill_2     : F393A00_4.Mill;
72
 
73
  B_Windmill : F393A00_2.Windmill;
74
  B_Pump     : F393A00_3.Pump;
75
  B_Mill     : F393A00_4.Mill;
76
 
77
  procedure Swapem( A,B: in out F393A00_2.Windmill'Class ) is
78
  begin
79
   F393A00_0.TC_Touch('x');
80
   F393A00_2.Swap( A,B );
81
  end Swapem;
82
 
83
  function Zephyr( A: F393A00_2.Windmill'Class )
84
           return F393A00_2.Windmill'Class is
85
    Item : F393A00_2.Windmill'Class := A;
86
  begin
87
    F393A00_0.TC_Touch('y');
88
    if not F393A00_1.Initialized( Item ) then  -- b
89
      F393A00_2.Initialize( Item );            -- a
90
    end if;
91
    F393A00_2.Stop( Item );                    -- f / mff
92
    F393A00_2.Add_Spin( Item, 10 );            -- e
93
    return Item;
94
  end Zephyr;
95
 
96
  function Gale( It: F393A00_2.Windmill ) return F393A00_2.Windmill'Class is
97
    Item : F393A00_2.Windmill'Class := It;
98
  begin
99
    F393A00_2.Stop( Item );                   -- f
100
    F393A00_2.Add_Spin( Item, 40 );           -- e
101
    return Item;
102
  end Gale;
103
 
104
  function Gale( It: F393A00_3.Pump ) return F393A00_2.Windmill'Class is
105
    Item : F393A00_2.Windmill'Class := It;
106
  begin
107
    F393A00_2.Stop( Item );                   -- f
108
    F393A00_2.Add_Spin( Item, 50 );           -- e
109
    return Item;
110
  end Gale;
111
 
112
  function Gale( It: F393A00_4.Mill ) return F393A00_2.Windmill'Class is
113
    Item : F393A00_2.Windmill'Class := It;
114
  begin
115
    F393A00_2.Stop( Item );                   -- mff
116
    F393A00_2.Add_Spin( Item, 60 );           -- e
117
    return Item;
118
  end Gale;
119
 
120
begin  -- Main test procedure.
121
 
122
  Report.Test ("C393A02", "Check that a dispatching call to an abstract "
123
                         & "subprogram invokes the correct subprogram body. "
124
                         & "Check that a subprogram declared with formal "
125
                         & "parameters/result of an abstract type's "
126
                         & "associated class-wide can be called" );
127
 
128
  F393A00_0.TC_Validate( "hhh", "Mill declarations" );
129
  A_Windmill := F393A00_2.Create;
130
  F393A00_0.TC_Validate( "d", "Create A_Windmill" );
131
 
132
  A_Pump     := F393A00_3.Create;
133
  F393A00_0.TC_Validate( "h", "Create A_Pump" );
134
 
135
  A_Mill     := F393A00_4.Create;
136
  F393A00_0.TC_Validate( "hl", "Create A_Mill" );
137
 
138
  --------------
139
 
140
  Swapem( A_Windmill, A_Windmill_2 );
141
  F393A00_0.TC_Validate( "xc", "Windmill Swap" );
142
 
143
  Swapem( A_Pump, A_Pump_2 );
144
  F393A00_0.TC_Validate( "xc", "Pump Swap" );
145
 
146
  Swapem( A_Mill, A_Mill_2 );
147
  F393A00_0.TC_Validate( "xk", "Pump Swap" );
148
 
149
  F393A00_2.Initialize( A_Windmill_2 );
150
  F393A00_3.Initialize( A_Pump_2 );
151
  F393A00_4.Initialize( A_Mill_2 );
152
  B_Windmill := A_Windmill_2;
153
  B_Pump     := A_Pump_2;
154
  B_Mill     := A_Mill_2;
155
  F393A00_2.Add_Spin( B_Windmill, 123 );
156
  F393A00_3.Set_Rate( B_Pump, 12.34 );
157
  F393A00_4.Add_Spin( B_Mill, 321 );
158
  F393A00_0.TC_Validate( "aaaeie", "Setting Values" );
159
 
160
  declare
161
    It : F393A00_2.Windmill'Class := Zephyr( B_Windmill ); -- ybfe
162
    XX : F393A00_2.Windmill'Class := Gale( B_Windmill );   -- fe
163
    use type F393A00_2.Rotational_Measurement;
164
  begin
165
    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
166
then
167
      Report.Failed( "Copy to class-wide variable" );
168
    end if;                                                -- bb
169
    if F393A00_2.Spin( It ) /= 10                          -- g
170
       or F393A00_2.Spin( XX ) /= 40 then                  -- g
171
      Report.Failed( "Call to class-wide operation" );
172
    end if;
173
 
174
    F393A00_0.TC_Validate( "ybfefebbgg", "Windmill Zephyr" );
175
  end;
176
 
177
  declare
178
    It : F393A00_2.Windmill'Class := Zephyr( B_Pump );     -- ybfe
179
    XX : F393A00_2.Windmill'Class := Gale( B_Pump );       -- fe
180
    use type F393A00_2.Rotational_Measurement;
181
  begin
182
    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
183
then
184
      Report.Failed( "Bad copy to class-wide variable" );
185
    end if;                                                -- bb
186
    if F393A00_2.Spin( It ) /= 10                          -- g
187
       or F393A00_2.Spin( XX ) /= 50 then                  -- g
188
      Report.Failed( "Call to class-wide operation" );
189
    end if;
190
 
191
    F393A00_0.TC_Validate( "ybfefebbgg", "Pump Zephyr" );
192
  end;
193
 
194
  declare
195
    It : F393A00_2.Windmill'Class := Zephyr( B_Mill );     -- ybmffe
196
    XX : F393A00_2.Windmill'Class := Gale( B_Mill );       -- mffe
197
    use type F393A00_2.Rotational_Measurement;
198
  begin
199
    if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
200
then
201
      Report.Failed( "Bad copy to class-wide variable" );
202
    end if;                                                -- bb
203
    if F393A00_2.Spin( It ) /= 10                          -- g
204
       or F393A00_2.Spin( XX ) /= 60 then                  -- g
205
      Report.Failed( "Call to class-wide operation" );
206
    end if;
207
 
208
    F393A00_0.TC_Validate( "ybmffemffebbgg", "Mill Zephyr" );
209
  end;
210
 
211
  Report.Result;
212
 
213
end C393A02;

powered by: WebSVN 2.1.0

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