1-- 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
46package 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
66end C3A0006_0;
67
68
69-----------------------------------------------------------------------------
70
71
72package 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
98end C3A0006_0;
99
100-----------------------------------------------------------------------------
101
102
103with Report;
104
105with C3A0006_0;
106
107procedure 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
128begin
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
163end C3A0006;
164