← Back to branch summary

~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to t/callext.t

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
Import upstream version 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/callext.t
 
1
#!/usr/local/bin/perl
 
2
 
 
3
# Example of how to use callext() - also see callext.c
 
4
 
 
5
use strict;
 
6
use Test;
 
7
BEGIN { plan tests => 1 }
 
8
use PDL;
 
9
use PDL::CallExt;
 
10
 
 
11
use PDL::Core ':Internal'; # For topdl()
 
12
use Config;
 
13
use File::Spec;
 
14
 
 
15
 
 
16
kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
 
17
 
 
18
sub tapprox {
 
19
        my($a,$b) = @_;
 
20
        my $c = abs($a-$b);
 
21
        my $d = max($c);
 
22
        $d < 0.01;
 
23
}
 
24
 
 
25
# Create the filenames
 
26
my $cfile = File::Spec->catfile('t', 'callext.c');
 
27
my $inc   = File::Spec->catdir('Basic', 'Core');
 
28
my $out   = File::Spec->catfile('t', 'callext.'.$Config{dlext});
 
29
 
 
30
# Compile the code
 
31
 
 
32
callext_cc($cfile, "-I$inc", '', $out);
 
33
 
 
34
my $y = sequence(5,4)+2;  # Create PDL
 
35
my $x = $y*20+100;        # Another
 
36
 
 
37
my $try    = loglog($x,$y);
 
38
my $correct = log(float($x))/log(float($y));
 
39
 
 
40
print "Try = $try\n";
 
41
print "Correct = $correct\n";
 
42
ok( tapprox($try, $correct) );
 
43
 
 
44
# Return log $x to base $y using callext() routine -
 
45
# perl wrapper makes this nice and easy to use.
 
46
 
 
47
sub loglog {
 
48
 
 
49
   die 'Usage: loglog($x,$y)' if scalar(@_)!=2;
 
50
 
 
51
   # Tips:
 
52
   #
 
53
   # (i)  topdl() forces arguments to be pdl vars even
 
54
   #      if ordinary numbers are passed
 
55
   #
 
56
   # (ii) float() forces the pdl vars to be float precision
 
57
   #      thus matching the C routine.
 
58
 
 
59
   my $x = float(topdl(shift));
 
60
   my $y = float(topdl(shift));
 
61
 
 
62
   my $ret = $x->copy; # Make copy of $x to return
 
63
 
 
64
   print "X = $x\n";
 
65
   print "Y = $y\n";
 
66
 
 
67
   my $ldfile = 
 
68
   callext($out, "loglog_ext", $ret, $y);
 
69
 
 
70
   return $ret;
 
71
}