Work at SourceForge, help us to make it a better place! We have an immediate need for a Support Technician in our San Francisco or Denver office.

Close

Diff of /t/plplot.t [b73ac3] .. [9bcce7] Maximize Restore

  Switch to unified view

a/t/plplot.t b/t/plplot.t
...
...
6
# Change 1..1 below to 1..last_test_to_print .
6
# Change 1..1 below to 1..last_test_to_print .
7
# (It may become useful if the test is moved to ./t subdirectory.)
7
# (It may become useful if the test is moved to ./t subdirectory.)
8
8
9
use PDL;
9
use PDL;
10
use PDL::Config;
10
use PDL::Config;
11
use Test::More;
12
13
BEGIN{
14
  use PDL::Config;
15
  if($PDL::Config{WITH_PLPLOT}) {
16
    plan tests => 35;
17
    use_ok( "PDL::Graphics::PLplot" );
11
use PDL::Graphics::PLplot;
18
  }
12
use Test::More qw(no_plan);
19
  else {
20
    plan skip_all => "PDL::Graphics::PLplot not installed";
21
  }
22
}
23
13
24
######################### End of black magic.
14
######################### End of black magic.
25
15
26
# Insert your test code below (better if it prints "ok 13"
16
# Insert your test code below (better if it prints "ok 13"
27
# (correspondingly "not ok 13") depending on the success of chunk 13
17
# (correspondingly "not ok 13") depending on the success of chunk 13
...
...
30
# Use xfig driver because it should always be installed.
20
# Use xfig driver because it should always be installed.
31
#my $dev = 'png';
21
#my $dev = 'png';
32
my $dev = 'xfig';
22
my $dev = 'xfig';
33
23
34
# redirect STDERR to purge silly 'opened *.xfig' messages
24
# redirect STDERR to purge silly 'opened *.xfig' messages
35
36
require IO::File;
37
local *SAVEERR;
38
*SAVEERR = *SAVEERR;  # stupid fix to shut up -w (AKA pain-in-the-...-flag)
39
open(SAVEERR, ">&STDERR");
40
my $tmp = new_tmpfile IO::File || die "couldn't open tmpfile";
41
my $pos = $tmp->getpos;
42
local *IN;
43
*IN = *$tmp;  # doesn't seem to work otherwise
44
open(STDERR,">&IN") or warn "couldn't redirect stdder";
45
25
46
my ($pl, $x, $y, $min, $max, $oldwin, $nbins);
26
my ($pl, $x, $y, $min, $max, $oldwin, $nbins);
47
27
48
28
49
### 
29
### 
...
...
52
#   --CED
32
#   --CED
53
###
33
###
54
34
55
my $tmpdir  = $PDL::Config{TEMPDIR} || "/tmp";
35
my $tmpdir  = $PDL::Config{TEMPDIR} || "/tmp";
56
my $tmpfile = $tmpdir . "/foo$$.$dev";
36
my $tmpfile = $tmpdir . "/foo$$.$dev";
57
58
# comment this out for testing!!!
59
#my $pid = 0; my $a = 'foo';
60
61
if($pid = fork()) {
62
  $a = waitpid($pid,0);
63
} else {
64
  sleep 1;
65
  $pl = PDL::Graphics::PLplot->new(DEV=>$dev,FILE=>$tmpfile);
66
  exit(0);    
67
}
68
69
ok( ($not_ok = $? & 0xff )==0 , "PLplot crash test"  );
70
unlink $tmpfile;
71
72
if($not_ok) {
73
  printf SAVEERR <<"EOERR" ;
74
75
Return value $not_ok; a is $a; pid is $pid
76
77
************************************************************************
78
* PLplot failed the crash test: it appears to crash its owner process. *
79
* This is probably due to a misconfiguration of the PLplot libraries.  *
80
* Next we\'ll try creating a test window from which will probably dump  *
81
* some (hopefully helpful) error messages and then die.                *
82
************************************************************************
83
84
EOERR
85
86
  open(STDERR,">&SAVEERR");
87
}
88
37
89
$pl = PDL::Graphics::PLplot->new (DEV => $dev,
38
$pl = PDL::Graphics::PLplot->new (DEV => $dev,
90
                  FILE => "test2.$dev",
39
                  FILE => "test2.$dev",
91
                  BACKGROUND => [255,255,255]);
40
                  BACKGROUND => [255,255,255]);
92
isa_ok( $pl, "PDL::Graphics::PLplot" ) or die;
41
isa_ok( $pl, "PDL::Graphics::PLplot" ) or die;
...
...
243
192
244
ok (-s "test11.$dev" > 0, "Colored symbol plot with key, via low level interface");
193
ok (-s "test11.$dev" > 0, "Colored symbol plot with key, via low level interface");
245
194
246
ok (sum(pdl(0.1, 0.85, 0.1, 0.9) - pdl($dev_xmin, $dev_xmax, $dev_ymin, $dev_ymax)) == 0, 
195
ok (sum(pdl(0.1, 0.85, 0.1, 0.9) - pdl($dev_xmin, $dev_xmax, $dev_ymin, $dev_ymax)) == 0, 
247
    "plgvpd call works correctly");
196
    "plgvpd call works correctly");
248
ok (abs(sum(pdl(-0.0001, 10.0001, -0.001, 100.001) - pdl($wld_xmin, $wld_xmax, $wld_ymin, $wld_ymax))) < 0.000001, 
197
ok (sum(abs(pdl(0, 10, 0, 100) - pdl($wld_xmin, $wld_xmax, $wld_ymin, $wld_ymax))) < 0.01,
249
    "plgvpw call works correctly");
198
    "plgvpw call works correctly");
250
199
251
# Test shade plotting (low level interface)
200
# Test shade plotting (low level interface)
252
plsdev ($dev);
201
plsdev ($dev);
253
plsfnam ("test12.$dev");
202
plsfnam ("test12.$dev");
...
...
476
                YLAB => ['x**2', 'sqrt(x)', 'x**3', 'sin(x/20*2pi)'],
425
                YLAB => ['x**2', 'sqrt(x)', 'x**3', 'sin(x/20*2pi)'],
477
                         COLOR => ['GREEN', 'DEEPSKYBLUE', 'DARKORCHID1', 'DEEPPINK'], XLAB => 'X label');
426
                         COLOR => ['GREEN', 'DEEPSKYBLUE', 'DARKORCHID1', 'DEEPPINK'], XLAB => 'X label');
478
$pl->close;
427
$pl->close;
479
ok (-s "test26.$dev" > 0, "Multi-color stripplots");
428
ok (-s "test26.$dev" > 0, "Multi-color stripplots");
480
429
481
# Test calling plParseOpts with no options
430
# test opening/closing of more than 100 streams (100 is the max number of plplot streams, close should
482
if($pid = fork()) {
431
# reuse plplot stream numbers).
483
  $a = waitpid($pid,0);
432
my $count = 0;
484
} else {
433
for my $i (1 .. 120) {
485
  sleep 1;
434
  my $pltfile = "test27.$dev";
486
  plParseOpts ([], PL_PARSE_FULL);
435
  my $win = PDL::Graphics::PLplot->new(DEV => $dev, FILE => $pltfile, PAGESIZE => [300, 300]);
487
  exit(0);    
436
  $win->xyplot(pdl(0,1), pdl(0,1));
437
  # print "Stream = ", plgstrm(), " Stream in object = ", $win->{STREAMNUMBER}, "\n";
438
  $win->close();
439
  if (-s $pltfile > 0) { $count++; unlink $pltfile }
488
}
440
}
489
ok( ($not_ok = $? & 0xff )==0 , "No segfault calling plParseOpts with no options"  );
441
ok ($count == 120, "Opening/closing of > 100 streams");
490
442
491
# comment this out for testing!!!
443
# comment this out for testing!!!
492
unlink glob ("test*.$dev");
444
unlink glob ("test*.$dev");
493
494
# stop STDERR redirection and examine output
495
496
open(STDERR, ">&SAVEERR");
497
$tmp->setpos($pos);  # rewind
498
my $txt = join '',<IN>;
499
close IN; undef $tmp;
500
501
print "\ncaptured STDERR: ('Opened ...' messages are harmless)\n$txt\n";
502
$txt =~ s/Opened test\d*\.$dev\n//sg;
503
warn $txt unless $txt =~ /\s*/;
504
445
505
# Local Variables:
446
# Local Variables:
506
# mode: cperl
447
# mode: cperl
507
# End:
448
# End: