3 -- Grant of Unlimited Rights
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
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.
27 -- Check that a function in a generic instance can be called using
28 -- an access-to-subprogram value.
31 -- Declare a numeric type in the visible part of a generic package.
32 -- Declare an access to function type. Declare three different sine
33 -- functions that can be referred to by the access to function type.
35 -- In the main program, instantiate the generic. Call each function
36 -- indirectly by dereferencing the access value.
40 -- 06 Dec 94 SAIC ACVC 2.0
45 type Real_Num
is digits <>;
49 TC_Call_Tag
: Natural := 0;
51 -- Type accesses to any sine function
52 type Sine_Function_Ptr
is access function
53 (Angle
: in Real_Num
) return Real_Num
;
55 function Sine_Calc_Fast
(Angle
: in Real_Num
) return Real_Num
;
57 function Sine_Calc_Acc
(Angle
: in Real_Num
) return Real_Num
;
59 function Sine_Calc_Table
(Angle
: in Real_Num
) return Real_Num
;
64 -----------------------------------------------------------------------------
67 package body C3A0003_0
is
69 function Sine_Calc_Fast
(Angle
: in Real_Num
) return Real_Num
is
70 Sine_Num
: Real_Num
:= 1.0;
77 function Sine_Calc_Acc
(Angle
: in Real_Num
) return Real_Num
is
78 Sine_Num
: Real_Num
:= 0.0;
85 function Sine_Calc_Table
(Angle
: in Real_Num
) return Real_Num
is
86 Sine_Num
: Real_Num
:= -1.0;
94 -----------------------------------------------------------------------------
101 type Real
is digits 5;
103 Subtype Trig_Float
is Real
range -1.0 .. 1.0;
105 package Trig
is new C3A0003_0
(Real_Num
=> Trig_Float
);
107 Sine_Access
: Trig
.Sine_Function_Ptr
;
108 X
, Theta
: Trig_Float
:= 0.0;
112 Report
.Test
("C3A0003", "Check that a function in a generic instance can "
113 & "be called using an access-to-subprogram value");
115 Sine_Access
:= Trig
.Sine_Calc_Fast
'Access;
117 -- Invoking Sine function designated by access value
118 X
:= Sine_Access
.all(Theta
);
120 If Trig
.TC_Call_Tag
/= 1 then
121 Report
.Failed
("Incorrect Sine_Calc_Fast result");
124 Sine_Access
:= Trig
.Sine_Calc_Acc
'Access;
126 -- Invoking Sine function designated by access value
127 X
:= Sine_Access
.all(Theta
);
129 If Trig
.TC_Call_Tag
/= 2 then
130 Report
.Failed
("Incorrect Sine_Calc_Acc result");
133 Sine_Access
:= Trig
.Sine_Calc_Table
'Access;
135 -- Invoking Sine function designated by access value
136 X
:= Sine_Access
.all(Theta
);
138 If Trig
.TC_Call_Tag
/= 3 then
139 Report
.Failed
("Incorrect Sine_Calc_Table result");