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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C3A0006.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 access to subprogram may be stored within data
28
--      structures, and that the access to subprogram can subsequently
29
--      be called.
30
--
31
-- TEST DESCRIPTION:
32
--      Declare an access to function type in a package specification.
33
--      Declare an array of the access type.  Declare three different
34
--      functions that can be referred to by the access to function type.
35
--
36
--      In the main program, declare a key function that builds the array
37
--      by calling each function indirectly through the access value.
38
--
39
--
40
-- CHANGE HISTORY:
41
--      06 Dec 94   SAIC    ACVC 2.0
42
--
43
--!
44
 
45
 
46
package C3A0006_0 is
47
 
48
   TC_Sine_Call  : Integer := 0;
49
   TC_Cos_Call   : Integer := 0;
50
   TC_Tan_Call   : Integer := 0;
51
 
52
   Sine_Value    : Float :=  4.0;
53
   Cos_Value     : Float :=  8.0;
54
   Tan_Value     : Float := 10.0;
55
 
56
   -- Type accesses to any function
57
   type Trig_Function_Ptr is access function
58
      (Angle : in Float) return Float;
59
 
60
   function Sine (Angle : in Float) return Float;
61
 
62
   function Cos  (Angle : in Float) return Float;
63
 
64
   function Tan  (Angle : in Float) return Float;
65
 
66
end C3A0006_0;
67
 
68
 
69
-----------------------------------------------------------------------------
70
 
71
 
72
package body C3A0006_0 is
73
 
74
   function Sine (Angle : in Float) return Float is
75
   begin
76
     TC_Sine_Call := TC_Sine_Call + 1;
77
     Sine_Value := Sine_Value + Angle;
78
     return Sine_Value;
79
   end Sine;
80
 
81
 
82
   function Cos  (Angle: in Float) return Float is
83
   begin
84
     TC_Cos_Call := TC_Cos_Call + 1;
85
     Cos_Value := Cos_Value - Angle;
86
     return Cos_Value;
87
   end Cos;
88
 
89
 
90
   function Tan (Angle : in Float) return Float is
91
   begin
92
     TC_Tan_Call := TC_Tan_Call + 1;
93
     Tan_Value := (Tan_Value + (Tan_Value * Angle));
94
     return Tan_Value;
95
   end Tan;
96
 
97
 
98
end C3A0006_0;
99
 
100
-----------------------------------------------------------------------------
101
 
102
 
103
with Report;
104
 
105
with C3A0006_0;
106
 
107
procedure C3A0006 is
108
 
109
   Trig_Value, Theta  : Float := 0.0;
110
 
111
   Total_Routines     : constant := 3;
112
 
113
   Sine_Total         : constant := 7.0;
114
   Cos_Total          : constant := 5.0;
115
   Tan_Total          : constant := 75.0;
116
 
117
   Trig_Table : array (1 .. Total_Routines) of C3A0006_0.Trig_Function_Ptr;
118
 
119
 
120
   -- Key function to build the table
121
   function Call_Trig_Func (Func : C3A0006_0.Trig_Function_Ptr;
122
                            Operand : Float) return Float is
123
   begin
124
      return (Func(Operand));
125
   end Call_Trig_Func;
126
 
127
 
128
begin
129
 
130
   Report.Test ("C3A0006", "Check that access to subprogram may be " &
131
                "stored within data structures, and that the access " &
132
                "to subprogram can subsequently be called");
133
 
134
   Trig_Table := (C3A0006_0.Sine'Access, C3A0006_0.Cos'Access,
135
                  C3A0006_0.Tan'Access);
136
 
137
   -- increase the value of Theta to build the table
138
   for I in 1 .. Total_Routines loop
139
      Theta := Theta + 0.5;
140
      for J in 1 .. Total_Routines loop
141
         Trig_Value     := Call_Trig_Func (Trig_Table(J), Theta);
142
      end loop;
143
   end loop;
144
 
145
   if C3A0006_0.TC_Sine_Call /= Total_Routines
146
     or C3A0006_0.TC_Cos_Call /= Total_Routines
147
     or C3A0006_0.TC_Tan_Call /= Total_Routines then
148
        Report.Failed ("Incorrect subprograms result");
149
   end if;
150
 
151
   if C3A0006_0.Sine_Value /= Sine_Total
152
     or C3A0006_0.Cos_Value /= Cos_Total
153
     or C3A0006_0.Tan_Value /= Tan_Total then
154
        Report.Failed ("Incorrect values returned from subprograms");
155
   end if;
156
 
157
   if Trig_Value /= Tan_Total then
158
        Report.Failed ("Incorrect call order.");
159
   end if;
160
 
161
   Report.Result;
162
 
163
end C3A0006;

powered by: WebSVN 2.1.0

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