1-- C3A0001.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 type can be used to select and
28--      invoke functions with appropriate arguments dynamically.
29--
30-- TEST DESCRIPTION:
31--      Declare an access to function type in a package specification.
32--      Declare three different sine functions that can be referred to by
33--      the access to function type.
34--
35--      In the main program, call each function indirectly by dereferencing
36--      the access value.
37--
38--
39-- CHANGE HISTORY:
40--      06 Dec 94   SAIC    ACVC 2.0
41--
42--!
43
44package C3A0001_0 is
45
46   TC_Call_Tag : Natural := 0;
47
48   -- Type accesses to any sine function
49   type Sine_Function_Ptr is access function
50      (Angle : in Float) return Float;
51
52-- Three 'Sine' functions that model an application situation in which
53-- one function might be chosen when speed is important, another (using
54-- a different algorithm) might be chosen when accuracy is important,
55-- and so on.
56
57   function Sine_Calc_Fast  (Angle : in Float) return Float;
58
59   function Sine_Calc_Acc   (Angle : in Float) return Float;
60
61   function Sine_Calc_Table (Angle : in Float) return Float;
62
63end C3A0001_0;
64
65
66-----------------------------------------------------------------------------
67
68
69package body C3A0001_0 is
70
71   function Sine_Calc_Fast (Angle : in Float) return Float is
72   begin
73      TC_Call_Tag := 1;
74      return 1.0;
75   end Sine_Calc_Fast;
76
77
78   function Sine_Calc_Acc (Angle : in Float) return Float is
79   begin
80      TC_Call_Tag := 2;
81      return 0.0;
82   end Sine_Calc_Acc;
83
84
85   function Sine_Calc_Table (Angle : in Float) return Float is
86   begin
87      TC_Call_Tag := 3;
88      return -1.0;
89   end Sine_Calc_Table;
90
91end C3A0001_0;
92
93-----------------------------------------------------------------------------
94
95with Report;
96with C3A0001_0;
97
98procedure C3A0001 is
99
100   Sine_Access : C3A0001_0.Sine_Function_Ptr;
101   X, Theta    : Float := 0.0;
102
103begin
104
105   Report.Test ("C3A0001", "Check that access to subprogram can be " &
106                "used to select and invoke an operation with " &
107                "appropriate arguments dynamically");
108
109   Sine_Access := C3A0001_0.Sine_Calc_Fast'Access;
110
111   -- Invoking Sine function designated by access value
112   X := Sine_Access(Theta);
113
114   If C3A0001_0.TC_Call_Tag /= 1 then
115      Report.Failed ("Incorrect Sine_Calc_Fast result");
116   end if;
117
118   Sine_Access := C3A0001_0.Sine_Calc_Acc'Access;
119
120   -- Invoking Sine function designated by access value
121   X := Sine_Access(Theta);
122
123   If C3A0001_0.TC_Call_Tag /= 2 then
124      Report.Failed ("Incorrect Sine_Calc_Acc result");
125   end if;
126
127   Sine_Access := C3A0001_0.Sine_Calc_Table'Access;
128
129   -- Invoking Sine function designated by access value
130   X := Sine_Access(Theta);
131
132   If C3A0001_0.TC_Call_Tag /= 3 then
133      Report.Failed ("Incorrect Sine_Calc_Table result");
134   end if;
135
136   Report.Result;
137
138end C3A0001;
139