File: pthread.t

package info (click to toggle)
pdl 2.005-4
  • links: PTS
  • area: main
  • in suites: potato
  • size: 4,200 kB
  • ctags: 3,301
  • sloc: perl: 14,876; ansic: 7,223; fortran: 3,417; makefile: 54; sh: 16
file content (53 lines) | stat: -rw-r--r-- 1,040 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

# XXX SOME TESTS DISABLED

use PDL::LiteF;
use Benchmark;

kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.

sub ok {
	my $no = shift ;
	my $result = shift ;
	if($ENV{PDL_T}) {
		if($result) { print "ok $no\n";return }
		my ($p,$f,$l) = caller;
		print "FAILED TEST $no AT $p $f $l\n";
	} else {
		print "not " unless $result ;
		print "ok $no\n" ;
	}
}

sub approx {
       my($a,$b,$mdiff) = @_;
       $mdiff = 0.01 unless defined($mdiff);
       my $c = abs($a-$b);
       my $d = max($c);
       $d < $mdiff;
}

if (PDL::Core::pthreads_enabled) {
  print "1..2\n";
  $a = zeroes(2000000);
  $b = zeroes(2000000);
  
  $a->add_threading_magic(0,10);
  
  timethese(50,{threaded => '$a += 1', unthreaded => '$b+= 1'});
  print $a->slice('0:20'),"\n";
  ok(1,approx($a,$b));

  $a = sequence(3,10);
  $b = ones(3);
  $a->add_threading_magic(1,2);
  $c = inner $a, $b;
  print $c,"\n";
  $a->remove_threading_magic;
  $cc = $a->sumover;
  print $cc,"\n";
  ok(2,approx($c,$cc));
} else {
  print "1..1\n";
  print "ok 1\n";
}