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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CC70003.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 the actual passed to a formal package may be a formal
28
--      access-to-subprogram type. Check that the visible part of the generic
29
--      formal package includes the first list of basic declarative items of
30
--      the package specification.
31
--
32
-- TEST DESCRIPTION:
33
--      Declare a list abstraction in a generic package which manages lists of
34
--      elements of any nonlimited type (foundation code). Declare a generic
35
--      package which supports the execution of lists of operations. Provide
36
--      the generic package with two formal parameters: (1) a formal access-
37
--      to-function type, and (2) a generic formal package with the list
38
--      abstraction package as template. Within a procedure declared in the
39
--      list-execution package, utilize information about the profile of
40
--      the functions in the list. Declare a package which declares functions
41
--      matching the profile of the formal access-to-subprogram type. In the
42
--      main program, create a list of pointers to the functions declared in
43
--      the package, instantiate the list abstraction and list-execution
44
--      packages, and use the list-execution procedure to call each of the
45
--      functions in the list in sequence.
46
--
47
--
48
-- CHANGE HISTORY:
49
--      06 Dec 94   SAIC    ACVC 2.0
50
--
51
--!
52
 
53
generic
54
   type Element_Type is private;
55
package CC70003_0 is  -- This package simulates a generic list abstraction.
56
 
57
   -- The definition of List_Type below is purely artificial; its validity
58
   -- in the context of the abstraction is irrelevant to the feature being
59
   -- tested.
60
 
61
   type Element_Ptr is access Element_Type;
62
 
63
   subtype List_Size is Natural range 1 .. 2;
64
   type List_Type is array (List_Size) of Element_Ptr;
65
 
66
   function  View_Element (I : List_Size; L : List_Type) return Element_Type;
67
 
68
   procedure Write_Element (I : in     List_Size;
69
                            L : in out List_Type;
70
                            E : in     Element_Type);
71
 
72
   -- ... Other list operations for Element_Type.
73
 
74
end CC70003_0;
75
 
76
 
77
     --==================================================================--
78
 
79
 
80
package body CC70003_0 is
81
 
82
   -- The implementations of the operations below are purely artificial; the
83
   -- validity of their implementations in the context of the abstraction is
84
   -- irrelevant to the feature being tested.
85
 
86
   function View_Element (I : List_Size; L : List_Type) return Element_Type is
87
   begin
88
      return L(I).all;
89
   end View_Element;
90
 
91
 
92
   procedure Write_Element (I : in     List_Size;
93
                            L : in out List_Type;
94
                            E : in     Element_Type) is
95
   begin
96
      L(I) := new Element_Type'(E);
97
   end Write_Element;
98
 
99
end CC70003_0;
100
 
101
 
102
     --==================================================================--
103
 
104
 
105
with CC70003_0;    -- Generic list abstraction.
106
generic
107
   type Elem_Type is access function (F : Float) return Float;
108
   with package List_Mgr is new CC70003_0 (Elem_Type);
109
package CC70003_1 is  -- This package simulates support for executing lists
110
                      -- of operations.
111
 
112
   procedure Execute_List (L : List_Mgr.List_Type; F : in out Float);
113
 
114
   -- ... Other operations.
115
 
116
end CC70003_1;
117
 
118
 
119
     --==================================================================--
120
 
121
 
122
package body CC70003_1 is
123
 
124
   procedure Execute_List (L : List_Mgr.List_Type; F : in out Float) is
125
   begin
126
      for I in L'Range loop
127
         F := List_Mgr.View_Element(I, L)(F);   -- Execute next operation in
128
      end loop;                                 -- list with current value of
129
   end Execute_List;                            -- F as operand.
130
 
131
 
132
end CC70003_1;
133
 
134
 
135
     --==================================================================--
136
 
137
 
138
package CC70003_2 is
139
 
140
   function Sine (F : Float) return Float;
141
   function Exp  (F : Float) return Float;
142
 
143
   -- ... Other math functions.
144
 
145
end CC70003_2;
146
 
147
 
148
     --==================================================================--
149
 
150
 
151
package body CC70003_2 is
152
 
153
   -- The implementations of the functions below are purely artificial; the
154
   -- validity of their implementations in the context of the abstraction is
155
   -- irrelevant to the feature being tested.
156
 
157
   function Sine (F : Float) return Float is
158
   begin
159
      return (-0.15);
160
   end Sine;
161
 
162
   function Exp (F : Float) return Float is
163
   begin
164
      if (F = 0.0) then
165
         return (-0.69);
166
      else
167
         return (2.0);  -- This branch should be taken.
168
      end if;
169
   end Exp;
170
 
171
end CC70003_2;
172
 
173
 
174
     --==================================================================--
175
 
176
 
177
with CC70003_0;    -- Generic list abstraction.
178
with CC70003_1;  -- Generic operation-list abstraction.
179
with CC70003_2;  -- Math library.
180
 
181
with Report;
182
procedure CC70003 is
183
 
184
   type Math_Op is access function (F : Float) return Float;
185
 
186
   package Math_Op_Lists        is new CC70003_0 (Math_Op);
187
   package Math_Op_List_Support is new CC70003_1 (Math_Op, Math_Op_Lists);
188
 
189
   Sin_Ptr : Math_Op := CC70003_2.Sine'Access;
190
   Exp_Ptr : Math_Op := CC70003_2.Exp'Access;
191
 
192
   Op_List : Math_Op_Lists.List_Type;
193
 
194
   Operand  : Float := 0.0;
195
   Expected : Float := 2.0;
196
 
197
 
198
begin
199
   Report.Test ("CC70003", "Check that the actual passed to a formal " &
200
                "package may be a formal access-to-subprogram type");
201
 
202
   Math_Op_Lists.Write_Element (1, Op_List, Sin_Ptr);
203
   Math_Op_Lists.Write_Element (2, Op_List, Exp_Ptr);
204
 
205
   Math_Op_List_Support.Execute_List (Op_List, Operand);
206
 
207
   if (Operand /= Expected) then
208
      Report.Failed ("Incorrect results from indirect function calls");
209
   end if;
210
 
211
   Report.Result;
212
end CC70003;

powered by: WebSVN 2.1.0

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