gcc/testsuite/ada/acats/tests/c3/c3a0008.a

   1 -- C3A0008.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 subprogram references may be passed as parameters using
  28 --      access-to-subprogram types. Check that the passed subprograms may
  29 --      be invoked from within the called subprogram.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      Declare an access to function type in a package specification.
  33 --      Declare three different trig functions that can be referred to by
  34 --      the access to function type.
  35 --
  36 --      In the main program, call each function indirectly by passing the
  37 --      access to subprogram value as parameter.
  38 --
  39 --
  40 -- CHANGE HISTORY:
  41 --      06 Dec 94   SAIC    ACVC 2.0
  42 --
  43 --!
  44
  45
  46 package Integrate_Lookup is
  47
  48   TC_Log_Call  : Boolean := False;
  49
  50   TC_Cos_Call  : Boolean := False;
  51
  52   TC_Sine_Call : Boolean := False;
  53
  54   -- Type accesses to functions Log, Sine, or Cos
  55   type Integrand_Ptr is access function
  56      (Angle : Float) return Float;
  57
  58   function Log  (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 Integrate  (Func : Integrand_Ptr; From, To: Float)
  65     return Float;
  66
  67 end Integrate_Lookup;
  68
  69
  70 -----------------------------------------------------------------------------
  71
  72
  73 package body Integrate_Lookup is
  74
  75
  76   function Log (Angle : in Float) return Float is
  77   begin
  78      TC_Log_Call := True;
  79      return 0.1;
  80   end Log;
  81
  82
  83   function Sine (Angle : in Float) return Float is
  84   begin
  85      TC_Sine_Call := True;
  86      return 0.0;
  87   end Sine;
  88
  89
  90   function Cos  (Angle : in Float) return Float is
  91   begin
  92      TC_Cos_Call := True;
  93      return 1.0;
  94   end Cos;
  95
  96
  97   function Integrate (Func : Integrand_Ptr; From, To: Float)
  98     return Float is
  99      Theta : Float;
 100   begin
 101      -- calls the actual subprogram passed as parameter
 102      Theta := Func (From) + Func (To);
 103      return Theta;
 104   end Integrate;
 105
 106 end Integrate_Lookup;
 107
 108
 109 -----------------------------------------------------------------------------
 110
 111
 112 with Report;
 113
 114 with Integrate_Lookup;
 115
 116 procedure C3A0008 is
 117
 118   Area : Float := 0.0;
 119
 120 begin
 121
 122   Report.Test ("C3A0008", "Check that subprogram references may be passed "
 123                         & "as parameters using access-to-subprogram types. "
 124                        & "Check that the passed subprograms may be invoked "
 125                         & "from within the called subprogram");
 126
 127   Area := Integrate_Lookup.Integrate
 128             (Integrate_Lookup.Log'Access, 1.0, 2.0);
 129
 130   If not Integrate_Lookup.TC_Log_Call or Area /= 0.2 then
 131      Report.Failed ("Incorrect Log result");
 132   end if;
 133
 134   Area := Integrate_Lookup.Integrate
 135             (Integrate_Lookup.Sine'Access, 1.0, 2.0);
 136
 137   If not Integrate_Lookup.TC_Sine_Call or Area /= 0.0 then
 138      Report.Failed ("Incorrect Sine result");
 139   end if;
 140
 141   Area := Integrate_Lookup.Integrate
 142             (Integrate_Lookup.Cos'Access, 1.0, 2.0);
 143
 144   If not Integrate_Lookup.TC_Cos_Call or Area /= 2.0 then
 145      Report.Failed ("Incorrect Cos result");
 146   end if;
 147
 148   Report.Result;
 149
 150 end C3A0008;