|
0 |
use strict;
|
|
1 |
use warnings;
|
| 0 | 2 |
use Test::More;
|
| 1 | 3 |
use PDL::Graphics::Gnuplot qw(plot gpwin);
|
| 2 | 4 |
use File::Temp qw(tempfile);
|
|
| 8 | 10 |
# $PDL::Graphics::Gnuplot::MS_io_braindamage = 1;
|
| 9 | 11 |
|
| 10 | 12 |
$ENV{GNUPLOT_DEPRECATED} = 1; # shut up deprecation warnings
|
| 11 | |
eval { $w=gpwin() };
|
|
13 |
my $w=eval { gpwin() };
|
| 12 | 14 |
|
| 13 | 15 |
is $@, '';
|
| 14 | 16 |
isa_ok($w, 'PDL::Graphics::Gnuplot', "Constructor created a plotting object");
|
| 15 | 17 |
|
| 16 | |
ok(length($PDL::Graphics::Gnuplot::gp_version), "Extracted a version string from gnuplot") or diag "Raw output: '$PDL::Graphics::Gnuplot::raw_output'";
|
|
18 |
isnt $PDL::Graphics::Gnuplot::gp_version, '', "Extracted a version string from gnuplot" or diag "Raw output: '$PDL::Graphics::Gnuplot::raw_output'";
|
| 17 | 19 |
|
| 18 | 20 |
diag( "\nP::G::G v$PDL::Graphics::Gnuplot::VERSION, gnuplot v$PDL::Graphics::Gnuplot::gp_version, Perl v$], $^X on $^O #\n" );
|
| 19 | 21 |
|
|
| 26 | 28 |
{
|
| 27 | 29 |
# test basic plotting
|
| 28 | 30 |
eval{ plot ( {terminal => 'dumb 79 24', output => $testoutput}, $x); };
|
| 29 | |
|
| 30 | |
|
| 31 | |
is($@, '', 'basic plotting succeeded without error' )
|
| 32 | |
or diag "plot() died with '$@'";
|
| 33 | |
|
| 34 | |
ok(-e $testoutput, 'basic plotting created an output file' )
|
| 35 | |
or diag "plot() didn't create an output file";
|
| 36 | |
|
|
31 |
is($@, '', 'basic plotting succeeded without error' );
|
|
32 |
ok(-e $testoutput, 'basic plotting created an output file' );
|
| 37 | 33 |
# call the output good if it's at least 80% of the nominal size
|
| 38 | 34 |
my @filestats = stat $testoutput;
|
| 39 | |
ok($filestats[7] > 79*24*0.8, 'basic plotting created a reasonably-sized file')
|
| 40 | |
or diag "resulting output file should be ascii 79x24, but only contains $filestats[7] bytes";
|
| 41 | |
|
|
35 |
cmp_ok($filestats[7], '>', 79*24*0.8, 'basic plotting created a reasonably-sized file');
|
| 42 | 36 |
PDL::Graphics::Gnuplot::restart();
|
| 43 | |
|
| 44 | |
unlink($testoutput) or warn "\$!: $!";
|
|
37 |
unlink($testoutput) or diag "\$!: $!";
|
| 45 | 38 |
}
|
| 46 | 39 |
|
| 47 | 40 |
ok($PDL::Graphics::Gnuplot::gp_version, "gp_version is nonzero after first use of P::G::G");
|
|
| 49 | 42 |
##############################
|
| 50 | 43 |
#
|
| 51 | 44 |
{
|
| 52 | |
# purposely fail. This one should fail by sensing that "bogus" is bogus, *before* sending
|
|
45 |
# purposely fail. This one should fail by sensing that "bogus" is bogus, *before* sending
|
| 53 | 46 |
# anything to Gnuplot.
|
| 54 | 47 |
|
| 55 | 48 |
eval{ plot ( {terminal => 'dumb 79 24', output => $testoutput, silent=>1}, with => 'bogus', $x); };
|
|
| 64 | 57 |
}
|
| 65 | 58 |
|
| 66 | 59 |
##############################
|
| 67 | |
#
|
| 68 | |
my $w;
|
|
60 |
#
|
|
61 |
eval { $w = gpwin( 'dumb', size=>[79,24],output=>$testoutput, wait=>1) };
|
|
62 |
is($@, '', "constructor works");
|
|
63 |
isnt ref $w, '', "constructor works";
|
| 69 | 64 |
|
| 70 | 65 |
SKIP:{
|
| 71 | 66 |
# Check timeout.
|
| 72 | |
eval {
|
| 73 | |
$w = gpwin( 'dumb', size=>[79,24],output=>$testoutput, wait=>1);
|
| 74 | |
};
|
| 75 | |
ok((!$@ and (ref $w)), "constructor works");
|
| 76 | |
|
| 77 | 67 |
skip "Skipping timeout test, which doesn't work under MS Windows", 1
|
| 78 | 68 |
if($PDL::Graphics::Gnuplot::MS_io_braindamage);
|
| 79 | |
|
| 80 | |
eval {
|
| 81 | |
$w->plot ( { topcmds=>'pause 2'}, with=>'line', $x); };
|
| 82 | |
|
| 83 | |
ok($@ && $@ =~ m/1 second/og, "gnuplot response timeout works" );
|
|
69 |
eval { $w->plot ( { topcmds=>'pause 2'}, with=>'line', $x) };
|
|
70 |
like($@, qr/1 second/, "gnuplot response timeout works");
|
| 84 | 71 |
}
|
| 85 | 72 |
|
| 86 | 73 |
eval { $w->restart };
|
|
| 93 | 80 |
|
| 94 | 81 |
# Some working variables
|
| 95 | 82 |
$x = xvals(51);
|
| 96 | |
my $y = $x*$x;
|
|
83 |
my $y = $x*$x;
|
| 97 | 84 |
|
| 98 | 85 |
do {
|
| 99 | 86 |
# Object options passed into plot are transient
|
| 100 | 87 |
$w = gpwin('dumb',size=>[79,24,'ch'], output=>$testoutput);
|
| 101 | 88 |
$w->options(xr=>[0,30]);
|
| 102 | |
ok( (defined($w->{options}->{xrange}) and
|
| 103 | |
((ref $w->{options}->{xrange}) eq 'ARRAY') and
|
| 104 | |
($w->{options}->{xrange}->[0] == 0) and
|
| 105 | |
($w->{options}->{xrange}->[1] == 30))
|
| 106 | |
,
|
| 107 | |
"xr sets xrange option properly in options call" );
|
|
89 |
is_deeply $w->{options}{xrange}, [0, 30],
|
|
90 |
"xr sets xrange option properly in options call";
|
| 108 | 91 |
$w->plot($x);
|
|
92 |
|
|
93 |
open FOO, "<$testoutput";
|
|
94 |
my @lines = <FOO>;
|
|
95 |
is( 0+@lines, 24, "setting 79x24 character dumb output yields 24 lines of output");
|
|
96 |
like $lines[-2], qr/.*\s30\s*$/,
|
|
97 |
"xrange option generates proper X axis (and dumb terminal behaves as expected)";
|
|
98 |
|
|
99 |
$w->plot($x,{xr=>[0,5]});
|
| 109 | 100 |
|
| 110 | 101 |
open FOO, "<$testoutput";
|
| 111 | 102 |
@lines = <FOO>;
|
| 112 | |
ok( 0+@lines == 24, "setting 79x24 character dumb output yields 24 lines of output");
|
| 113 | |
$s = $lines[$#lines - 1];
|
| 114 | |
$s =~ s/\s*$//; # trim trailing whitespace
|
| 115 | |
$s =~ s/.*\s//; # trim everything before the final X axis label
|
| 116 | |
ok( $s == 30, "xrange option generates proper X axis (and dumb terminal behaves as expected)");
|
| 117 | |
|
| 118 | |
$w->plot($x,{xr=>[0,5]});
|
| 119 | |
|
| 120 | |
open FOO, "<$testoutput";
|
| 121 | |
@lines = <FOO>;
|
| 122 | |
$s = $lines[$#lines - 1];
|
| 123 | |
$s =~ s/\s*$//; # trim trailing whitespace
|
| 124 | |
$s =~ s/.*\s//; # trim everything before the final X axis label
|
| 125 | |
ok( $s == 5, "inline xrange option overrides stored xrange option (and dumb terminal behaves as expected)");
|
| 126 | |
|
| 127 | |
ok( ((defined($w->{options}->{xrange}) and
|
| 128 | |
(ref $w->{options}->{xrange}) eq 'ARRAY' and
|
| 129 | |
$w->{options}->{xrange}->[0] == 0 and
|
| 130 | |
$w->{options}->{xrange}->[1] == 30))
|
| 131 | |
,
|
| 132 | |
"inline xrange does not change stored xrange option"
|
| 133 | |
);
|
| 134 | |
|
| 135 | |
ok( (defined ($w->{last_plot}) and
|
| 136 | |
(ref ($w->{last_plot}) eq 'HASH') and
|
| 137 | |
defined ($w->{last_plot}->{options}) and
|
| 138 | |
(ref ($w->{last_plot}->{options}) eq 'HASH') and
|
| 139 | |
defined ($w->{last_plot}->{options}->{xrange}) and
|
| 140 | |
(ref ($w->{last_plot}->{options}->{xrange}) eq 'ARRAY') and
|
| 141 | |
$w->{last_plot}->{options}->{xrange}->[0] == 0 and
|
| 142 | |
$w->{last_plot}->{options}->{xrange}->[1] == 5)
|
| 143 | |
,
|
| 144 | |
"inline xrange is stored in last_plot options"
|
| 145 | |
);
|
|
103 |
like $lines[-2], qr/.*\s5\s*$/,
|
|
104 |
"inline xrange option overrides stored xrange option (and dumb terminal behaves as expected)";
|
|
105 |
|
|
106 |
is_deeply $w->{options}{xrange}, [0, 30],
|
|
107 |
"inline xrange does not change stored xrange option";
|
|
108 |
|
|
109 |
is_deeply $w->{last_plot}{options}{xrange}, [0, 5],
|
|
110 |
"inline xrange is stored in last_plot options";
|
| 146 | 111 |
};
|
| 147 | 112 |
|
| 148 | 113 |
unlink($testoutput) or warn "\$!: $!";
|
|
| 152 | 117 |
#
|
| 153 | 118 |
# Normally we issue a "reset" before sending options for each plot, to ensure that
|
| 154 | 119 |
# gnuplot is in a known state -- but in multiplots we can't do that or we'd break the
|
| 155 | |
# multiplot. We attempt to eradicate leftover state in gnuplot, so we have to test
|
|
120 |
# multiplot. We attempt to eradicate leftover state in gnuplot, so we have to test
|
| 156 | 121 |
# that. The main thing is that labels should be cleared.
|
| 157 | 122 |
{
|
| 158 | 123 |
$w = gpwin('dumb',size=>[79,24,'ch'], output=>$testoutput);
|
| 159 | |
|
| 160 | 124 |
$w->multiplot(layout=>[1,2]);
|
| 161 | 125 |
$w->line(xvals(5)**2,{xlabel=>"FOO BAR BAZ"});
|
| 162 | |
$w->line(xvals(5)**2); # no xlabel -- should not print one
|
|
126 |
$w->line(xvals(5)**2); # no xlabel -- should not print one
|
| 163 | 127 |
$w->end_multi;
|
| 164 | 128 |
undef $w;
|
| 165 | 129 |
open FOO,"<$testoutput";
|
| 166 | |
@lines = grep m/FOO BAR BAZ/,(<FOO>);
|
| 167 | |
ok(@lines==1, "xlabel gets reset on multiplots");
|
|
130 |
my @lines = grep m/FOO BAR BAZ/,(<FOO>);
|
|
131 |
is 0+@lines, 1, "xlabel gets reset on multiplots";
|
| 168 | 132 |
}
|
| 169 | 133 |
|
| 170 | 134 |
##############################
|
| 171 | 135 |
# Test ascii data transfer (binary is tested by default on platforms where it works)
|
| 172 | 136 |
eval {$w = gpwin('dumb', size=>[79,24,'ch'],output=>$testoutput);};
|
| 173 | |
ok((!$@ && !!$w),"opened window for ascii transfer tests");
|
| 174 | |
|
| 175 | |
eval { $w->options( binary=>0 ); };
|
| 176 | |
ok( !$@, "set binary mode to 0" );
|
|
137 |
is $@, '';
|
|
138 |
ok($w,"opened window for ascii transfer tests");
|
|
139 |
|
|
140 |
eval { $w->options( binary=>0 ); };
|
|
141 |
is $@, '', "set binary mode to 0";
|
| 177 | 142 |
|
| 178 | 143 |
eval { $w->plot( xvals(5), xvals(5)**2 ); };
|
| 179 | 144 |
is($@, '', "ascii plot succeeded");
|
| 180 | 145 |
|
| 181 | 146 |
eval { $w->plot( xvals(10000), xvals(10000)->sqrt ); };
|
| 182 | |
is($@, '', "looong ascii plot succeeded ".($@?"($@)":""));
|
| 183 | |
|
|
147 |
is($@, '', "looong ascii plot succeeded ");
|
| 184 | 148 |
|
| 185 | 149 |
##############################
|
| 186 | 150 |
# Test replotting
|
| 187 | 151 |
|
| 188 | 152 |
eval {$w = gpwin('dumb',size=>[79,24,'ch'], output=>$testoutput)};
|
| 189 | |
ok((!$@ && !!$w),"re-opened window");
|
|
153 |
is $@, '';
|
|
154 |
ok($w,"re-opened window");
|
| 190 | 155 |
|
| 191 | 156 |
eval { $w->plot({xr=>[0,30]},xvals(50),xvals(50)**2); };
|
| 192 | 157 |
is($@, ''," plot works");
|
| 193 | 158 |
|
| 194 | |
|
| 195 | 159 |
open FOO,"<$testoutput";
|
| 196 | |
@lines = <FOO>;
|
|
160 |
my @lines = <FOO>;
|
| 197 | 161 |
close FOO;
|
| 198 | |
ok(@lines == 24, "test plot made 24 lines");
|
|
162 |
is(0+@lines, 24, "test plot made 24 lines");
|
| 199 | 163 |
|
| 200 | 164 |
eval { $w->restart(); };
|
| 201 | 165 |
is($@, '',"restart succeeded");
|
|
| 203 | 167 |
unlink($testoutput) or warn "\$!: $!";
|
| 204 | 168 |
ok(!(-e $testoutput), "test file got deleted");
|
| 205 | 169 |
|
| 206 | |
|
| 207 | 170 |
eval { $w->replot(); };
|
| 208 | 171 |
is($@, '', "replot works");
|
| 209 | 172 |
|
| 210 | 173 |
open FOO,"<$testoutput";
|
| 211 | |
@l2 = <FOO>;
|
|
174 |
my @l2 = <FOO>;
|
| 212 | 175 |
close FOO;
|
| 213 | 176 |
$w->restart;
|
| 214 | 177 |
unlink($testoutput) or warn "\$!: $!";
|
| 215 | |
ok(@l2 == 24, "test replot made 24 lines");
|
| 216 | |
|
| 217 | |
$same =1;
|
| 218 | |
for $i(0..23) {
|
| 219 | |
$same &= ($lines[$i] eq $l2[$i]);
|
| 220 | |
}
|
| 221 | |
ok($same, "replot reproduces output");
|
|
178 |
is(0+@l2, 24, "test replot made 24 lines");
|
|
179 |
|
|
180 |
is_deeply \@lines, \@l2, "replot reproduces output";
|
| 222 | 181 |
|
| 223 | 182 |
eval { $w->replot(xvals(50),40*xvals(50)) };
|
| 224 | 183 |
is($@, '', "replotting and adding a line works");
|
|
| 226 | 185 |
# lame test - just make sure the plots include at least two lines
|
| 227 | 186 |
# and that one is higher than the other.
|
| 228 | 187 |
open FOO,"<$testoutput";
|
| 229 | |
@l3 = <FOO>;
|
|
188 |
my @l3 = <FOO>;
|
| 230 | 189 |
close FOO;
|
| 231 | 190 |
$w->restart;
|
| 232 | 191 |
unlink($testoutput) or warn "\$!: $!";
|
| 233 | |
ok(@l3==24,"test replot again made 24 lines");
|
|
192 |
is(0+@l3, 24, "test replot again made 24 lines");
|
| 234 | 193 |
|
| 235 | 194 |
if($w->{gp_version} == 5.0 && $Alien::Gnuplot::pl==0
|
| 236 | 195 |
or
|
|
| 238 | 197 |
) {
|
| 239 | 198 |
# gnuplot 5.0 patchlevel 0 uses plusses and hyphens to draw curves in ASCII
|
| 240 | 199 |
# match whitespace / curve / whitespace / curve / whitespace on line 12
|
| 241 | |
ok($l3[12] =~ m/\s+[\-\+]+\s+[\-\+]+\s+/, "test plot has two curves");
|
|
200 |
like($l3[12], qr/\s+[\-\+]+\s+[\-\+]+\s+/, "test plot has two curves");
|
| 242 | 201 |
} else {
|
| 243 | 202 |
# most gnuplots use #'s and *'s for the first two ASCII curves
|
| 244 | |
ok($l3[12]=~ m/\#\s+\*/, "test plot has two curves and curve 2 is above curve 1");
|
|
203 |
like($l3[12], qr/\#\s+\*/, "test plot has two curves and curve 2 is above curve 1");
|
| 245 | 204 |
}
|
| 246 | 205 |
|
| 247 | 206 |
# test that options updating modifies the replot
|
|
| 249 | 208 |
is($@, '', "options set and replot don't crash");
|
| 250 | 209 |
|
| 251 | 210 |
open FOO,"<$testoutput";
|
| 252 | |
@l4 = <FOO>;
|
|
211 |
my @l4 = <FOO>;
|
| 253 | 212 |
close FOO;
|
| 254 | 213 |
$w->restart;
|
| 255 | 214 |
unlink($testoutput) or warn "\$!: $!";
|
| 256 | |
ok(@l4 == 24, "replot made 24 lines after option set");
|
| 257 | |
|
| 258 | |
$same = 1;
|
| 259 | |
for $i(0..23) {
|
| 260 | |
$same &= ($l3[$i] eq $l4[$i]);
|
| 261 | |
}
|
| 262 | |
ok(!$same, "modifying plot option affects replot");
|
| 263 | |
|
|
215 |
is 0+@l4, 24, "replot made 24 lines after option set";
|
|
216 |
|
|
217 |
my $diff = grep $l3[$_] ne $l4[$_], 0..23;
|
|
218 |
ok($diff, "modifying plot option affects replot");
|
| 264 | 219 |
|
| 265 | 220 |
##############################
|
| 266 | 221 |
# Test parsing of plot options when provided before curve options
|
|
| 270 | 225 |
is($@, '', "plot() worked for x,y plot with unescaped plot option");
|
| 271 | 226 |
|
| 272 | 227 |
eval { $w->plot(ls=>4,xmin=>3,xvals(10),xvals(10)) };
|
| 273 | |
ok($@=~m/No curve option found that matches \'xmin\'/, "xmin after a curve option fails (can't mix curve and plot options)");
|
|
228 |
like($@, qr/No curve option found that matches \'xmin\'/, "xmin after a curve option fails (can't mix curve and plot options)");
|
| 274 | 229 |
|
| 275 | 230 |
eval { $w->plot(xmin=>3,xrange=>[4,5],xvals(10),xvals(10)) };
|
| 276 | 231 |
is($@, '', "plot works when curve options are given after plot options");
|
|
| 278 | 233 |
do {
|
| 279 | 234 |
open FOO,"<$testoutput";
|
| 280 | 235 |
my @lines = <FOO>;
|
| 281 | |
ok($lines[22]=~ m/^\s*4\s+.*\s+5\s+$/, "curve option range overrides plot option range");
|
|
236 |
like($lines[22], qr/^\s*4\s+.*\s+5\s+$/, "curve option range overrides plot option range");
|
| 282 | 237 |
close FOO;
|
| 283 | 238 |
};
|
| 284 | 239 |
|
|
| 296 | 251 |
is($@, '', "two arguments, both arrays, works OK");
|
| 297 | 252 |
|
| 298 | 253 |
eval { $w->plot(xmin=>3,xrange=>[4,5],xvals(10),[1,2,3])};
|
| 299 | |
ok($@ =~ m/mismatch/, "Mismatch detected in array size vs. PDL size");
|
|
254 |
like($@, qr/mismatch/, "Mismatch detected in array size vs. PDL size");
|
| 300 | 255 |
|
| 301 | 256 |
##############################
|
| 302 | 257 |
# Test placement of topcmds, extracmds, and bottomcmds
|
| 303 | 258 |
eval { $w->plot(xmin=>3,extracmds=>'reset',xrange=>[4,5],xvals(10),xvals(10)**2); };
|
| 304 | 259 |
is($@, '', "extracmds does not cause an error");
|
| 305 | |
ok( $PDL::Graphics::Gnuplot::last_plotcmd =~ m/\]\s+reset\s+plot/o, "extracmds inserts exactly one copy in the right place");
|
|
260 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/\]\s+reset\s+plot/o, "extracmds inserts exactly one copy in the right place");
|
| 306 | 261 |
|
| 307 | 262 |
eval { $w->plot(xmin=>3,topcmds=>'reset',xrange=>[4,5],xvals(10),xvals(10)**2);};
|
| 308 | 263 |
is($@, '', "topcmds does not cause an error");
|
| 309 | |
ok( $PDL::Graphics::Gnuplot::last_plotcmd =~ m/set\s+output\s+\"[^\"]+\"\s+reset\s+set\s+palette/o, "topcmds inserts exactly one copy in the right place");
|
|
264 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/set\s+output\s+\"[^\"]+\"\s+reset\s+set\s+palette/o, "topcmds inserts exactly one copy in the right place");
|
| 310 | 265 |
|
| 311 | 266 |
eval { $w->plot(xmin=>3,bottomcmds=>'reset',xrange=>[4,5],xvals(10),xvals(10)**2);};
|
| 312 | 267 |
is($@, '', "bottomcmds does not cause an error");
|
| 313 | |
ok( $PDL::Graphics::Gnuplot::last_plotcmd =~ m/\]\s+reset\s*$/o, "bottomcmds inserts exactly one copy in the right place");
|
|
268 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/\]\s+reset\s*$/o, "bottomcmds inserts exactly one copy in the right place");
|
| 314 | 269 |
|
| 315 | 270 |
##############################
|
| 316 | 271 |
# Test tuple size determination: 2-D, 3-D, and variables (palette and variable)
|
|
| 323 | 278 |
is($@, '', "2-D line plot accepts two PDLs");
|
| 324 | 279 |
|
| 325 | 280 |
eval { $w->plot(xvals(10),xvals(10),xvals(10));};
|
| 326 | |
ok($@ =~ m/Found 3 PDLs for 2D plot type/, "2-D line plot rejects three PDLs");
|
|
281 |
like($@, qr/Found 3 PDLs for 2D plot type/, "2-D line plot rejects three PDLs");
|
| 327 | 282 |
|
| 328 | 283 |
eval { $w->plot(ps=>'variable',with=>'points',xvals(10),xvals(10),xvals(10)) };
|
| 329 | 284 |
is($@, '', "2-D plot with one variable parameter takes three PDLs");
|
| 330 | 285 |
|
| 331 | 286 |
eval { $w->plot(ps=>'variable',with=>'points',xvals(10),xvals(10),xvals(10),xvals(10)) };
|
| 332 | |
ok($@ =~ m/Found 4 PDLs for 2D/, "2-D plot with one variable parameter rejects four PDLs");
|
|
287 |
like($@, qr/Found 4 PDLs for 2D/, "2-D plot with one variable parameter rejects four PDLs");
|
| 333 | 288 |
|
| 334 | 289 |
SKIP: {
|
| 335 | |
skip "Skipping unsupported mode for deprecated earlier gnuplot",1
|
|
290 |
skip "Skipping unsupported mode for deprecated earlier gnuplot",1
|
| 336 | 291 |
if($PDL::Graphics::Gnuplot::gp_version < 4.4);
|
| 337 | 292 |
eval { $w->plot3d(xvals(10,10))};
|
| 338 | 293 |
is($@, '', "3-D plot accepts one PDL if it is an image");
|
| 339 | 294 |
};
|
| 340 | 295 |
|
| 341 | 296 |
eval { $w->plot3d(xvals(10),xvals(10)); };
|
| 342 | |
ok($@ =~ m/Found 2 PDLs for 3D/,"3-D plot rejects two PDLs");
|
|
297 |
like($@, qr/Found 2 PDLs for 3D/,"3-D plot rejects two PDLs");
|
| 343 | 298 |
|
| 344 | 299 |
eval { $w->plot3d(xvals(10),xvals(10),xvals(10)); };
|
| 345 | 300 |
is($@, '', "3-D plot accepts three PDLs");
|
| 346 | 301 |
|
| 347 | 302 |
eval { $w->plot3d(xvals(10),xvals(10),xvals(10),xvals(10)); };
|
| 348 | |
ok($@ =~ m/Found 4 PDLs for 3D/,"3-D plot rejects four PDLs");
|
|
303 |
like($@, qr/Found 4 PDLs for 3D/,"3-D plot rejects four PDLs");
|
| 349 | 304 |
|
| 350 | 305 |
eval { $w->plot3d(ps=>'variable',with=>'points',xvals(10),xvals(10),xvals(10),xvals(10));};
|
| 351 | 306 |
is($@, '', "3-D plot accepts four PDLs with one variable element");
|
| 352 | 307 |
|
| 353 | 308 |
eval { $w->plot3d(with=>'points',ps=>'variable',palette=>1,xvals(10),xvals(10),xvals(10),xvals(10));};
|
| 354 | |
ok($@ =~ m/Found 4 PDLs for 3D/,"3-D plot rejects four PDLs with two variable elements");
|
|
309 |
like($@, qr/Found 4 PDLs for 3D/,"3-D plot rejects four PDLs with two variable elements");
|
| 355 | 310 |
|
| 356 | 311 |
SKIP: {
|
| 357 | |
skip "Skipping unsupported mode for deprecated earlier gnuplot",1
|
|
312 |
skip "Skipping unsupported mode for deprecated earlier gnuplot",1
|
| 358 | 313 |
if($PDL::Graphics::Gnuplot::gp_version < 4.4);
|
| 359 | 314 |
eval { $w->plot3d(with=>'points',ps=>'variable',palette=>1,xvals(10),xvals(10),xvals(10),xvals(10),xvals(10));};
|
| 360 | 315 |
is($@, '', "3-D plot accepts five PDLs with one variable element");
|
| 361 | 316 |
} ;
|
| 362 | 317 |
|
| 363 | 318 |
eval { $w->plot3d(with=>'points',ps=>'variable',palette=>1,xvals(10),xvals(10),xvals(10),xvals(10),xvals(10),xvals(10));};
|
| 364 | |
ok($@ =~ m/Found 6 PDLs for 3D/,"3-D plot rejects six PDLs with two variable elements");
|
|
319 |
like($@, qr/Found 6 PDLs for 3D/,"3-D plot rejects six PDLs with two variable elements");
|
| 365 | 320 |
|
| 366 | 321 |
|
| 367 | 322 |
##############################
|
|
| 370 | 325 |
is($@, '', "normal legend plotting works OK");
|
| 371 | 326 |
|
| 372 | 327 |
eval { $w->plot(legend=>['line 1', 'line 2'], pdl(2,3,4)); };
|
| 373 | |
ok($@ =~ m/Legend has 2 entries; but 1 curve/, "Failure to thread crashes");
|
|
328 |
like($@, qr/Legend has 2 entries; but 1 curve/, "Failure to thread crashes");
|
| 374 | 329 |
|
| 375 | 330 |
eval { $w->plot(legend=>['line 1'], pdl([2,3,4],[1,2,3])); };
|
| 376 | |
ok($@ =~ m/Legend has 1 entry; but 2 curve/, "Failure to thread crashes (other way)");
|
|
331 |
like($@, qr/Legend has 1 entry; but 2 curve/, "Failure to thread crashes (other way)");
|
| 377 | 332 |
|
| 378 | 333 |
eval { $w->plot(legend=>['line 1','line 2'], pdl([2,3,4],[1,2,3]),[3,4,5]) };
|
| 379 | |
ok($@ =~ m/only 1-D PDLs are allowed to be mixed with array/, "Can't thread with array refs");
|
|
334 |
like($@, qr/only 1-D PDLs are allowed to be mixed with array/, "Can't thread with array refs");
|
| 380 | 335 |
|
| 381 | 336 |
eval { $w->plot(legend=>['line 1','line 2'], pdl([2,3,4],[1,2,3]),[3,4]) };
|
| 382 | |
ok($@ =~ m/only 1-D PDLs/, "Mismatched arguments are rejected");
|
|
337 |
like($@, qr/only 1-D PDLs/, "Mismatched arguments are rejected");
|
| 383 | 338 |
|
| 384 | 339 |
##############################
|
| 385 | 340 |
# Test non-persistence of autoset options
|
| 386 | 341 |
eval { $w->options(xrange=>[1,2]); };
|
| 387 | |
ok((!$@ and $w->{options}->{xrange}->[0] == 1 and $w->{options}->{xrange}->[1] == 2), "xrange set ok\n");
|
|
342 |
is_deeply $w->{options}{xrange}, [1, 2], "xrange set ok\n";
|
| 388 | 343 |
|
| 389 | 344 |
eval { $w->reset; $w->restart; };
|
| 390 | 345 |
is($@, '', "reset was ok\n");
|
| 391 | 346 |
|
| 392 | |
ok( !defined($w->{options}->{xrange}), "reset cleared xrange option" );
|
|
347 |
is $w->{options}{xrange}, undef, "reset cleared xrange option";
|
| 393 | 348 |
|
| 394 | 349 |
eval { $w->plot(with=>'lines', xvals(5)); };
|
| 395 | |
ok( !defined($w->{options}->{xrange}), "plotting a line did not set xrange option" );
|
|
350 |
is $w->{options}{xrange}, undef, "plotting a line did not set xrange option";
|
| 396 | 351 |
|
| 397 | 352 |
eval { $w->plot(with=>'image', rvals(5,5)); };
|
| 398 | |
ok( !defined($w->{options}->{xrange}), "plotting an image did not set xrange option" );
|
| 399 | |
|
|
353 |
is $w->{options}{xrange}, undef, "plotting an image did not set xrange option";
|
| 400 | 354 |
|
| 401 | 355 |
##############################
|
| 402 | 356 |
# Test esoteric argument parsing
|
| 403 | 357 |
|
| 404 | 358 |
eval { $w->plot(with=>'lines',y2=>3,xvals(5)); };
|
| 405 | |
ok($@ =~ m/No curve option found that matches \'y2\'/,"y2 gets rejected");
|
|
359 |
like($@, qr/No curve option found that matches \'y2\'/,"y2 gets rejected");
|
| 406 | 360 |
|
| 407 | 361 |
eval { $w->plot(with=>'lines',xvals(5),{lab2=>['foo',at=>[2,3]]}); };
|
| 408 | 362 |
is($@, '', "label is accepted ($@)");
|
|
| 418 | 372 |
|
| 419 | 373 |
sub get_axis_testoutput {
|
| 420 | 374 |
my $file = shift;
|
| 421 | |
my $n = shift;
|
| 422 | 375 |
open FOO,"<$file";
|
| 423 | 376 |
my @lines = <FOO>;
|
| 424 | |
|
| 425 | 377 |
chomp for @lines;
|
| 426 | |
|
| 427 | 378 |
for my $i(0..$#lines) {
|
| 428 | 379 |
last if( $lines[$#lines] =~ m/[^\s]/ );
|
| 429 | 380 |
pop @lines;
|
| 430 | 381 |
}
|
| 431 | |
|
| 432 | |
return @lines[-1..-$n];
|
|
382 |
my $line = $lines[-1];
|
|
383 |
$line =~ s/^\s+//;
|
|
384 |
$line;
|
| 433 | 385 |
}
|
| 434 | 386 |
|
| 435 | 387 |
eval { $w->plot(xvals(50)->sqrt) };
|
| 436 | |
ok( !$@, "plotting after reset worked ok with autotics" );
|
| 437 | |
|
| 438 | |
|
| 439 | |
$line_nums = (get_axis_testoutput($testoutput, 1));
|
| 440 | |
$line_nums =~ s/^\s+//;
|
| 441 | |
$nums= pdl( split /\s+/,$line_nums);
|
| 442 | |
|
| 443 | |
ok( $nums->nelem==11 && all( $nums == pdl(0,5,10,15,20,25,30,35,40,45,50) ), "autogenerated tics work (case 1)" );
|
| 444 | |
|
|
388 |
is $@, '', "plotting after reset worked ok with autotics";
|
|
389 |
|
|
390 |
my $line_nums = get_axis_testoutput($testoutput);
|
|
391 |
is_deeply [split /\s+/,$line_nums], [0,5,10,15,20,25,30,35,40,45,50], "autogenerated tics work (case 1)";
|
| 445 | 392 |
|
| 446 | 393 |
eval { $w->plot(xvals(50)->sqrt,{xtics=>0}) };
|
| 447 | 394 |
is($@, '', "xvals plot (no xtics) succeeded");
|
| 448 | 395 |
|
| 449 | |
ok($w->{last_plotcmd} =~ m/unset xtics/o, "xtics=>0 generated an 'unset xtics' command");
|
| 450 | |
|
| 451 | |
|
| 452 | |
$line_nums = (get_axis_testoutput($testoutput,1));
|
| 453 | |
ok($line_nums =~ m/\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-/, "No labels with xtics=>0");
|
| 454 | |
|
|
396 |
like($w->{last_plotcmd}, qr/unset xtics/, "xtics=>0 generated an 'unset xtics' command");
|
|
397 |
|
|
398 |
$line_nums = get_axis_testoutput($testoutput);
|
|
399 |
like $line_nums, qr/-------------------------------/, "No labels with xtics=>0";
|
| 455 | 400 |
|
| 456 | 401 |
eval { $w->plot(xvals(50)->sqrt,{"mxtics"=>{}})};
|
| 457 | 402 |
is($@, '', "plot with mxtics set to a hash succeeded");
|
|
| 459 | 404 |
eval { $w->plot(xvals(50)->sqrt,{xtics=>10})};
|
| 460 | 405 |
is($@, '', "xvals plot(xtics=>10) succeeded");
|
| 461 | 406 |
|
| 462 | |
$line_nums = (get_axis_testoutput($testoutput,1));
|
| 463 | |
$line_nums =~ s/^\s+//;
|
| 464 | |
$nums= pdl( split /\s+/,$line_nums);
|
| 465 | |
ok( $nums->nelem==6 && all( $nums == pdl(0,10,20,30,40,50) ), "tics with spacing 10 work");
|
|
407 |
$line_nums = get_axis_testoutput($testoutput);
|
|
408 |
is_deeply [split /\s+/,$line_nums], [0,10,20,30,40,50], "tics with spacing 10 work";
|
| 466 | 409 |
|
| 467 | 410 |
eval { $w->plot(xvals(50)->sqrt, {xtics=>[]}) };
|
| 468 | 411 |
is($@, '', "xvals plot (xtics=>[]) succeeded");
|
| 469 | 412 |
|
| 470 | |
$line_nums = (get_axis_testoutput($testoutput, 1));
|
| 471 | |
$line_nums =~ s/^\s+//;
|
| 472 | |
$nums= pdl( split /\s+/,$line_nums);
|
| 473 | |
ok( $nums->nelem==11 && all( $nums == pdl(0,5,10,15,20,25,30,35,40,45,50) ), "autogenerated tics work (case 2)" );
|
|
413 |
$line_nums = get_axis_testoutput($testoutput);
|
|
414 |
is_deeply [split /\s+/,$line_nums], [0,5,10,15,20,25,30,35,40,45,50], "autogenerated tics work (case 2)";
|
| 474 | 415 |
|
| 475 | 416 |
undef $w;
|
| 476 | 417 |
unlink($testoutput) or warn "\$!: $!";
|
|
| 484 | 425 |
eval { $w->plot(xvals(500)-10, xvals(500)+40, { autoscale=>{} }) };
|
| 485 | 426 |
is($@, '', "autoscale accepts an empty hash ref");
|
| 486 | 427 |
|
| 487 | |
$ticks = (get_axis_testoutput($testoutput,1));
|
| 488 | |
$ticks =~ s/^\s*//;
|
| 489 | |
$ticks = pdl(split /\s+/,$ticks);
|
| 490 | |
ok($ticks->nelem==12 && all($ticks == pdl(-50,0,50,100,150,200,250,300,350,400,450,500)),"autoscale=>{} gives correct scaling");
|
| 491 | |
|
| 492 | |
eval { $w->plot(xvals(500)-10,xvals(500)+40,{ autoscale=>{x=>fix}}); };
|
|
428 |
my $ticks = get_axis_testoutput($testoutput);
|
|
429 |
is_deeply [split /\s+/,$ticks], [-50,0,50,100,150,200,250,300,350,400,450,500], "autoscale=>{} gives correct scaling";
|
|
430 |
|
|
431 |
eval { $w->plot(xvals(500)-10,xvals(500)+40,{ autoscale=>{x=>'fix'}}); };
|
| 493 | 432 |
is($@, '', "autoscale accepts a non-empty hash ref");
|
| 494 | 433 |
|
| 495 | |
$ticks = (get_axis_testoutput($testoutput,1));
|
| 496 | |
$ticks=~ s/^\s*//;
|
| 497 | |
$ticks = pdl(split /\s+/,$ticks);
|
| 498 | |
ok($ticks->nelem==10 && all($ticks == pdl(0,50,100,150,200,250,300,350,400,450)),"autoscale=>{x=>fix} fixes the X axis scaling");
|
|
434 |
$ticks = get_axis_testoutput($testoutput);
|
|
435 |
is_deeply [split /\s+/,$ticks], [0,50,100,150,200,250,300,350,400,450], "autoscale=>{x=>fix} fixes the X axis scaling";
|
| 499 | 436 |
|
| 500 | 437 |
undef $w;
|
| 501 | 438 |
unlink($testoutput) or warn "\$!: $!";
|
| 502 | 439 |
|
| 503 | 440 |
|
| 504 | 441 |
##############################
|
| 505 | |
# Check default-location plotting
|
|
442 |
# Check default-location plotting
|
| 506 | 443 |
if( -e 'Plot-1.txt' ) {
|
| 507 | 444 |
unlink 'Plot-1.txt' or warn "Can't delete Plot-1.txt: $!";
|
| 508 | 445 |
}
|
|
| 521 | 458 |
# accepts both array ref and scalar parameters.
|
| 522 | 459 |
eval {$w=gpwin('dumb',size=>[7,5]); $w->line(xvals(50)**2); $w->close;};
|
| 523 | 460 |
is($@, '', "plotting to 42x30 text file worked");
|
| 524 | |
eval {open FOO,"<Plot-1.txt"; @lines = <FOO>; close FOO;};
|
|
461 |
@lines = eval {open FOO,"<Plot-1.txt"; my @l = <FOO>; close FOO;@l};
|
| 525 | 462 |
is($@, '', "read ASCII plot OK");
|
| 526 | 463 |
eval { unlink 'Plot-1.txt';};
|
| 527 | 464 |
|
| 528 | |
ok(@lines+0 == 30, "'7x5 inch' ascii plot created 30 lines (created ".(0+@lines).")");
|
|
465 |
is(@lines+0, 30, "'7x5 inch' ascii plot created 30 lines (created ".(0+@lines).")");
|
| 529 | 466 |
|
| 530 | 467 |
eval {$w=gpwin('dumb',size=>5); $w->line(xvals(50)**2); $w->close;};
|
| 531 | 468 |
is($@, '', "plotting to 30x30 text file worked");
|
|
| 533 | 470 |
is($@, '', "Read ASCII plot #2 OK");
|
| 534 | 471 |
eval { unlink 'Plot-1.txt';};
|
| 535 | 472 |
|
| 536 | |
ok(@lines+0==30,"'5x5 inch' ascii plot with scalar size param worked");
|
| 537 | |
|
|
473 |
is(@lines+0, 30,"'5x5 inch' ascii plot with scalar size param worked");
|
| 538 | 474 |
|
| 539 | 475 |
##############################
|
| 540 | 476 |
# Interactive tests
|
|
477 |
|
|
478 |
sub ask_yn {
|
|
479 |
my ($msg, $label) = @_;
|
|
480 |
print STDERR "\n\n$msg (Y/n)";
|
|
481 |
my $a = <STDIN>;
|
|
482 |
unlike($a, qr/n/i, $label);
|
|
483 |
}
|
| 541 | 484 |
|
| 542 | 485 |
SKIP: {
|
| 543 | 486 |
unless(exists($ENV{GNUPLOT_INTERACTIVE})) {
|
|
| 545 | 488 |
skip "Skipping interactive tests - set env. variable GNUPLOT_INTERACTIVE to enable.",29;
|
| 546 | 489 |
}
|
| 547 | 490 |
|
| 548 | |
eval { $w = gpwin('wxt'); };
|
| 549 | |
if($@) {
|
| 550 | |
$@ = undef;
|
| 551 | |
eval { $w = gpwin('x11'); }
|
| 552 | |
}
|
|
491 |
eval { $w = gpwin('wxt') };
|
|
492 |
eval { $w = gpwin('x11') } if $@;
|
| 553 | 493 |
is($@, '', "created a wxt or x11 plot object");
|
| 554 | 494 |
|
| 555 | |
ok((ref($PDL::Graphics::Gnuplot::termTab->{$w->{terminal}}) eq 'HASH'), "Terminal is a known type");
|
| 556 | |
|
|
495 |
isa_ok $PDL::Graphics::Gnuplot::termTab->{$w->{terminal}}, 'HASH', "Terminal is a known type";
|
|
496 |
|
| 557 | 497 |
ok($PDL::Graphics::Gnuplot::termTab->{$w->{terminal}}->{disp}, "Default terminal is a display type");
|
| 558 | 498 |
print STDERR "\n\nwindow is type ".$w->{terminal}."\n\n";
|
| 559 | |
$x = sequence(101)-50;
|
|
499 |
my $x = sequence(101)-50;
|
| 560 | 500 |
|
| 561 | 501 |
eval { $w->plot($x**2); };
|
| 562 | 502 |
is($@, '', "plot a parabola to a the display window");
|
| 563 | |
|
| 564 | |
print STDERR "\n\nIs there a display window and does it show a parabola? (Y/n)";
|
| 565 | |
$a = <STDIN>;
|
| 566 | |
ok($a !~ m/n/i, "parabola looks OK");
|
|
503 |
ask_yn "Is there a display window and does it show a parabola?", "parabola looks OK";
|
| 567 | 504 |
|
| 568 | 505 |
if($PDL::Graphics::Gnuplot::termTab->{$w->{terminal}}->{disp}>1) {
|
| 569 | |
print STDERR "\n\nMouse over the plot window. Are there metrics at bottom that update? (Y/n)";
|
| 570 | |
$a = <STDIN>;
|
| 571 | |
ok($a !~ m/n/i, "parabola has metrics");
|
| 572 | |
|
| 573 | |
|
|
506 |
ask_yn "Mouse over the plot window. Are there metrics at bottom that update?", "parabola has metrics";
|
| 574 | 507 |
if($PDL::Graphics::Gnuplot::gp_version < 4.6) {
|
| 575 | 508 |
print STDERR "\n\nYou're running an older gnuplot ($PDL::Graphics::Gnuplot::gp_version) and \nwon't be able to scroll. You should upgrade. Skipping scroll test.\n\n";
|
| 576 | 509 |
ok(1,"no scroll/zoom test");
|
| 577 | 510 |
} else {
|
| 578 | |
print STDERR "\n\nTry to scroll and zoom the parabola using the scrollbar or (mac) two-fingered\n scrolling in Y; use SHIFT to scroll in X, CTRL (command on mac) to zoom. Does it work? (Y/n)";
|
| 579 | |
$a = <STDIN>;
|
| 580 | |
ok($a !~ m/n/i, "parabola can be scrolled and zoomed");
|
|
511 |
ask_yn "Try to scroll and zoom the parabola using the scrollbar or (mac) two-fingered\n scrolling in Y; use SHIFT to scroll in X, CTRL (command on mac) to zoom. Does it work?", "parabola can be scrolled and zoomed";
|
| 581 | 512 |
}
|
| 582 | |
|
| 583 | |
|
| 584 | 513 |
} else {
|
| 585 | 514 |
print STDERR "\n\nThe $w->{terminal} gnuplot terminal has no built-in metrics, skipping that test.\n\n";
|
| 586 | 515 |
ok(1,"skipping metrics test");
|
| 587 | |
|
| 588 | 516 |
print STDERR "\n\nThe $w->{terminal} gnuplot terminal has no interactive zoom, skipping that test.\n\n";
|
| 589 | 517 |
ok(1,"skipping interactive-zoom test");
|
| 590 | 518 |
}
|
|
| 595 | 523 |
{y2t=>[0,5e7,4e8],y2r=>[0,3.5e8]}
|
| 596 | 524 |
);};
|
| 597 | 525 |
print $PDL::Graphics::Gnuplot::last_plotcmd."\n";
|
| 598 | |
print STDERR "\n\nAre there two curves labeled X^2 and X^5, with about the same vertical extent on the plot? (Y/n)";
|
| 599 | |
$a = <STDIN>;
|
| 600 | |
ok($a !~ m/n/i, "two curves are OK");
|
| 601 | |
|
| 602 | |
print STDERR "\n\nAre there appropriate tick marks in both Y1 and Y2 on opposite sides of the plot?\n";
|
| 603 | |
print STDERR " (There should be no ghost ticks from Y1 on the Y2 axis, or vice versa). (Y/n)";
|
| 604 | |
$a = <STDIN>;
|
| 605 | |
ok($a !~ m/n/i, "ticks look OK");
|
|
526 |
ask_yn "Are there two curves labeled X^2 and X^5, with about the same vertical extent on the plot?", "two curves are OK";
|
|
527 |
ask_yn "Are there appropriate tick marks in both Y1 and Y2 on opposite sides of the plot?\n (There should be no ghost ticks from Y1 on the Y2 axis, or vice versa).", "ticks look OK";
|
| 606 | 528 |
|
| 607 | 529 |
eval { $w->reset; $w->options(binary=>0,tee=>1); $w->plot( {title => "Parabola with error bars"},
|
| 608 | 530 |
with=>"xyerrorbars", legend=>"Parabola",
|
| 609 | 531 |
$x**2 * 10, abs($x)/10, abs($x)*5 ); };
|
| 610 | 532 |
print $PDL::Graphics::Gnuplot::last_plotcmd."\n";
|
| 611 | |
print STDERR "\n\nAre there error bars in both X and Y, both increasing away from the vertex, wider in X than Y? (Y/n)";
|
| 612 | |
$a = <STDIN>;
|
| 613 | |
ok($a !~ m/n/i, "error bars are OK");
|
| 614 | |
|
| 615 | |
$xy = zeros(21,21)->ndcoords - pdl(10,10);
|
| 616 | |
$z = inner($xy, $xy);
|
| 617 | |
eval { $w->reset; $w->plot({title => 'Heat map',
|
|
533 |
ask_yn "Are there error bars in both X and Y, both increasing away from the vertex, wider in X than Y?", "error bars are OK";
|
|
534 |
|
|
535 |
my $xy = zeros(21,21)->ndcoords - pdl(10,10);
|
|
536 |
my $z = inner($xy, $xy);
|
|
537 |
eval { $w->reset; $w->plot({title => 'Heat map',
|
| 618 | 538 |
'3d' => 1,
|
| 619 | 539 |
view=>[50,30,1],
|
| 620 | 540 |
zrange=>[-1,1]
|
| 621 | 541 |
},
|
| 622 | |
with => 'image', $z*2);
|
|
542 |
with => 'image', $z*2);
|
| 623 | 543 |
};
|
| 624 | 544 |
is($@, '', "3-d plot didn't crash");
|
| 625 | |
|
| 626 | |
print STDERR "\n\nDo you see a purple-yellow colormap image of a radial target, in 3-D? (Y/n)";
|
| 627 | |
$a = <STDIN>;
|
| 628 | |
ok($a !~ m/n/i, "3-D heat map plot works OK");
|
| 629 | |
|
| 630 | |
print STDERR "\n\nTry to rotate, pan, and zoom the 3-D image. Work OK? (Y/n)";
|
| 631 | |
$a = <STDIN>;
|
| 632 | |
ok($a !~ m/n/i, "Interact with 3-D image");
|
| 633 | |
|
| 634 | |
$pi = 3.14159;
|
| 635 | |
$theta = zeros(200)->xlinvals(0, 6*$pi);
|
|
545 |
ask_yn "Do you see a purple-yellow colormap image of a radial target, in 3-D?", "3-D heat map plot works OK";
|
|
546 |
ask_yn "Try to rotate, pan, and zoom the 3-D image. Work OK?", "Interact with 3-D image";
|
|
547 |
|
|
548 |
my $pi = 3.14159;
|
|
549 |
my $theta = zeros(200)->xlinvals(0, 6*$pi);
|
| 636 | 550 |
$z = zeros(200)->xlinvals(0, 5);
|
| 637 | 551 |
eval { $w->reset; $w->plot3d(cos($theta), sin($theta), $z); };
|
| 638 | |
|
| 639 | 552 |
is($@, '', "plot3d works");
|
| 640 | |
|
| 641 | |
print STDERR "\n\nSee a nice 3-D plot of a spiral? (Y/n)";
|
| 642 | |
$a = <STDIN>;
|
| 643 | |
ok($a !~ m/n/i, "See a nice 3-D plot of a spiral?");
|
|
553 |
ask_yn "See a nice 3-D plot of a spiral?", "See a nice 3-D plot of a spiral?";
|
| 644 | 554 |
|
| 645 | 555 |
$x = xvals(5);
|
| 646 | 556 |
$y = xvals(5)**2;
|
| 647 | |
$labels = ['one','two','three','four','five'];
|
|
557 |
my $labels = ['one','two','three','four','five'];
|
| 648 | 558 |
eval { $w->reset; $w->plot(xr=>[-1,6],yr=>[-1,26],with=>'labels',$x,$y,$labels); };
|
| 649 | |
print STDERR "\n\nSee the labels with words 'one','two','three','four', and 'five'? (Y/n)";
|
| 650 | |
$a = <STDIN>;
|
| 651 | |
ok($a !~ m/n/i, "labels plot is OK");
|
| 652 | |
|
|
559 |
ask_yn "See the labels with words 'one','two','three','four', and 'five'?", "labels plot is OK";
|
|
560 |
|
| 653 | 561 |
$x = xvals(51)-25; $y = $x**2;
|
| 654 | 562 |
eval { $w->reset; $w->plot({title=>"Parabolic fit"},
|
| 655 | 563 |
with=>"yerrorbars", legend=>"data", $x, $y+(random($y)-0.5)*2*$y/20, pdl($y/20),
|
| 656 | 564 |
with=>"lines", legend=>"fit", $x, $y); };
|
| 657 | 565 |
is($@, '', "mocked-up fit plot works");
|
| 658 | |
print STDERR "\n\nSee a green parabola with red error bar points on it? (Y/n)";
|
| 659 | |
$a = <STDIN>;
|
| 660 | |
ok($a !~ m/n/i, "parabolic plot is OK");
|
| 661 | |
|
| 662 | |
$pi = 3.14159;
|
|
566 |
ask_yn "See a green parabola with red error bar points on it?", "parabolic plot is OK";
|
|
567 |
|
| 663 | 568 |
$theta = xvals(201) * 6 * $pi / 200;
|
| 664 | 569 |
$z = xvals(201) * 5 / 200;
|
| 665 | |
|
| 666 | 570 |
eval { $w->reset; $w->plot( {'3d' => 1, title => 'double helix'},
|
| 667 | 571 |
with => 'linespoints', pointsize=>'variable', pointtype=>2, palette=>1 ,
|
| 668 | 572 |
legend => 'spiral 1',
|
|
| 672 | 576 |
legend => 'spiral 2',
|
| 673 | 577 |
-cos($theta), -sin($theta), $z, 0.5 + abs(cos($theta)*2),
|
| 674 | 578 |
sin($theta/3)
|
| 675 | |
);};
|
| 676 | |
|
|
579 |
);};
|
| 677 | 580 |
is($@, '', "double helix plot worked");
|
| 678 | |
|
| 679 | |
print STDERR "\n\nSee a double helix plot with variable point sizes and variable color? (Y/n)";
|
| 680 | |
$a = <STDIN>;
|
| 681 | |
ok($a !~ m/n/i, "double helix plot is OK");
|
|
581 |
ask_yn "See a double helix plot with variable point sizes and variable color?", "double helix plot is OK";
|
| 682 | 582 |
|
| 683 | 583 |
eval { $w->reset; $w->plot( with=>'image', rvals(9,9), {xr=>[undef,9]}) };
|
| 684 | 584 |
is($@, '', "image plot succeeded");
|
| 685 | |
print STDERR <<"FOO";
|
| 686 | |
|
| 687 | |
|
| 688 | |
You should see a 9x9 rvals image, scaled from -0.5 to 9.0 in X and -0.5 to
|
| 689 | |
8.5 in y. There should be a blank vertical bar 1/2 unit wide at the right
|
| 690 | |
side of the image. The other sides of the plot should be flush. Ok? (Y/n)
|
| 691 | |
FOO
|
| 692 | |
$a =<STDIN>;
|
| 693 | |
|
| 694 | |
ok($a !~ m/n/i, "image initial ranging plot is OK");
|
| 695 | |
|
| 696 | |
eval { $w->plot(with=>'image',rvals(9,9),
|
|
585 |
ask_yn "You should see a 9x9 rvals image, scaled from -0.5 to 9.0 in X and -0.5 to
|
|
586 |
8.5 in y. There should be a blank vertical bar 1/2 unit wide at the right
|
|
587 |
side of the image. The other sides of the plot should be flush. Ok?",
|
|
588 |
"image initial ranging plot is OK";
|
|
589 |
|
|
590 |
eval { $w->plot(with=>'image',rvals(9,9),
|
| 697 | 591 |
with=>'image', xvals(9,9)+7, yvals(9,9)+4, rvals(9,9),
|
| 698 | 592 |
with=>'line', xvals(20)->sqrt
|
| 699 | 593 |
);
|
| 700 | 594 |
};
|
| 701 | 595 |
is($@, '', "two-image range test plot succeeded");
|
| 702 | |
print STDERR <<"FOO";
|
| 703 | |
|
| 704 | |
|
| 705 | |
You should see two overlapping rvals images, with lower left pixels centered
|
| 706 | |
on (0,0) and (7,4), respectively, and a square root curve superimposed.
|
| 707 | |
The y range should be flush with the top and bottom of the two images. The
|
| 708 | |
x range should be set by the image at left and the curve at right, running
|
| 709 | |
from -0.5 to 20.0. The curve should end at 19.0. Ok? (Y/n)
|
| 710 | |
FOO
|
| 711 | |
$a = <STDIN>;
|
| 712 | |
ok($a !~ m/n/i, "image/line ranging plot is OK");
|
|
596 |
ask_yn "You should see two overlapping rvals images, with lower left pixels centered
|
|
597 |
on (0,0) and (7,4), respectively, and a square root curve superimposed.
|
|
598 |
The y range should be flush with the top and bottom of the two images. The
|
|
599 |
x range should be set by the image at left and the curve at right, running
|
|
600 |
from -0.5 to 20.0. The curve should end at 19.0. Ok?",
|
|
601 |
"image/line ranging plot is OK";
|
| 713 | 602 |
|
| 714 | 603 |
if($PDL::Bad::Status) {
|
| 715 | |
eval {
|
|
604 |
eval {
|
| 716 | 605 |
$w = gpwin();
|
| 717 | 606 |
$w->multiplot(layout=>[2,1]);
|
| 718 | |
$a = xvals(11)**2;
|
|
607 |
$a = xvals(11)**2;
|
| 719 | 608 |
$a->slice("(5)") .= asin(pdl(1.1));
|
| 720 | 609 |
$b = (xvals(11)**2)->setbadif(xvals(11)==5);
|
| 721 | 610 |
print "a=$a\n";
|
|
| 725 | 614 |
$w->line($b, {title=>"Parabola with BAD at x=5"});
|
| 726 | 615 |
$w->end_multi;
|
| 727 | 616 |
};
|
| 728 | |
|
| 729 | 617 |
is($@, '', "bad value plot succeeded");
|
| 730 | |
print STDERR <<"FOO";
|
| 731 | |
|
| 732 | |
The two panels should have the same plot with different titles: Y=X**2,
|
| 733 | |
with a segment missing from X=4 to X=6. OK?
|
| 734 | |
FOO
|
| 735 | |
$a = <STDIN>;
|
| 736 | |
ok($a !~ m/n/i, "bad value plot looks OK");
|
|
618 |
ask_yn "The two panels should have the same plot with different titles: Y=X**2,
|
|
619 |
with a segment missing from X=4 to X=6. OK?",
|
|
620 |
"bad value plot looks OK";
|
| 737 | 621 |
} else {
|
| 738 | 622 |
ok(1, "Skipping bad-value test since this PDL doesn't support badvals");
|
| 739 | 623 |
ok(1, "Skipping bad-value test since this PDL doesn't support badvals");
|
|
| 745 | 629 |
#
|
| 746 | 630 |
|
| 747 | 631 |
if( $ENV{DISPLAY} and $PDL::Graphics::Gnuplot::valid_terms->{x11} ) {
|
| 748 | |
eval { $w=gpwin(x11); $w->image(rvals(9,9), {title=>"X11 window for mouse test"}) };
|
|
632 |
eval { $w=gpwin('x11'); $w->image(rvals(9,9), {title=>"X11 window for mouse test"}) };
|
| 749 | 633 |
is($@, '', "plotting to x11 window worked.");
|
| 750 | 634 |
|
| 751 | 635 |
print STDERR "\n\nClick in the X11 window for mouse test.\n";
|
|
| 753 | 637 |
is($@, '', "Mouse test read a click");
|
| 754 | 638 |
|
| 755 | 639 |
# Try with a new window
|
| 756 | |
$w=gpwin($w->{terminal});
|
|
640 |
$w=gpwin($w->{terminal});
|
| 757 | 641 |
eval { print $w->read_mouse(); };
|
| 758 | 642 |
like $@, qr/no existing/,"Trying to read the mouse input on an empty window doesn't work";
|
| 759 | |
|
|
643 |
|
| 760 | 644 |
} else {
|
| 761 | 645 |
ok(1,"Skipping x11 plot");
|
| 762 | 646 |
ok(1,"Skipping click test for non-x11 device");
|
|
| 770 | 654 |
is($@, '', "dumb terminal still works");
|
| 771 | 655 |
|
| 772 | 656 |
# Some date stamps
|
| 773 | |
@dates = (-14552880, # Apollo 11 launch
|
|
657 |
my @dates = (-14552880, # Apollo 11 launch
|
| 774 | 658 |
0, # UNIX epoch
|
| 775 | 659 |
818410080, # SOHO launch
|
| 776 | 660 |
946684799, # The banking system did not melt down.
|
| 777 | 661 |
1054404000); # A happy moment in 2003
|
| 778 | |
$dates = pdl(@dates);
|
|
662 |
my $dates = pdl(@dates);
|
| 779 | 663 |
|
| 780 | 664 |
eval { $w->plot( {xdata=>'time'}, with=>'points', $dates->clip(0), xvals($dates) ); };
|
| 781 | 665 |
is($@, '', "time plotting didn't fail");
|
| 782 | 666 |
open FOO,"<$testoutput";
|
| 783 | |
$lines1 = join("",(<FOO>));
|
|
667 |
my $lines1 = join("",(<FOO>));
|
| 784 | 668 |
close FOO;
|
| 785 | 669 |
|
| 786 | 670 |
eval { $w->plot( {xr=>[0,$dates->max],xdata=>'time'}, with=>'points', $dates, xvals($dates) ); };
|
| 787 | 671 |
is($@, '', "time plotting with range didn't fail");
|
| 788 | 672 |
open FOO,"<$testoutput";
|
| 789 | |
$lines2 = join("",(<FOO>));
|
|
673 |
my $lines2 = join("",(<FOO>));
|
| 790 | 674 |
close FOO;
|
| 791 | 675 |
|
| 792 | 676 |
eval { $w->plot( {xr=>[$dates->at(3),$dates->at(4)], xdata=>'time'}, with=>'points', $dates, xvals($dates));};
|
| 793 | 677 |
is($@, '', "time plotting with a different range didn't fail");
|
| 794 | 678 |
open FOO,"<$testoutput";
|
| 795 | |
$lines3 = join("",(<FOO>));
|
|
679 |
my $lines3 = join("",(<FOO>));
|
| 796 | 680 |
close FOO;
|
| 797 | 681 |
|
| 798 | 682 |
print "lines1:\n$lines1\n\nlines2:\n$lines2\n\nlines3:\n$lines3\n\n";
|
| 799 | 683 |
SKIP: {
|
| 800 | 684 |
skip "Skipping date ranging tests since Gnuplot itself doesn't work",2;
|
| 801 | |
ok($lines1 eq $lines2, "Setting the time range to what it would be anyway duplicates the graph");
|
| 802 | |
ok($lines2 cmp $lines3, "Modifying the time range modifies the graph");
|
|
685 |
is($lines1, $lines2, "Setting the time range to what it would be anyway duplicates the graph");
|
|
686 |
isnt($lines2, $lines3, "Modifying the time range modifies the graph");
|
| 803 | 687 |
}
|
| 804 | 688 |
|
| 805 | 689 |
|
|
| 813 | 697 |
close FOO;
|
| 814 | 698 |
|
| 815 | 699 |
SKIP:{
|
| 816 | |
skip "Skipping title tests due to obsolete version of gnuplot (BSD uses 4.2, which fails these)",3
|
|
700 |
skip "Skipping title tests due to obsolete version of gnuplot (BSD uses 4.2, which fails these)",3
|
| 817 | 701 |
if($w->{gp_version} < $PDL::Graphics::Gnuplot::gnuplot_req_v);
|
| 818 | 702 |
|
| 819 | 703 |
like("@lines[0..3]", qr/This is a plot title/, "Plot title gets placed on plot")
|
|
| 821 | 705 |
|
| 822 | 706 |
eval { $w->plot({title=>""},with=>'points',xvals(5));};
|
| 823 | 707 |
is($@, '', "Non-title plotting works, no error");
|
| 824 | |
|
|
708 |
|
| 825 | 709 |
open FOO,"<$testoutput";
|
| 826 | 710 |
@lines = <FOO>;
|
| 827 | 711 |
close FOO;
|
| 828 | 712 |
if($w->{gp_version} < 5.2) {
|
| 829 | |
ok($lines[1] =~ m/^\s*$/, "Setting empty plot title sets an empty title");
|
|
713 |
like($lines[1], qr/^\s*$/, "Setting empty plot title sets an empty title");
|
| 830 | 714 |
} else {
|
| 831 | 715 |
# Late-model gnuplots use the top lines if there is no title
|
| 832 | |
ok($lines[1] =~ m/\-{50,70}/);
|
|
716 |
like($lines[1], qr/\-{50,70}/);
|
| 833 | 717 |
}
|
| 834 | 718 |
}
|
| 835 | 719 |
|
|
| 842 | 726 |
eval { $w->plot({trid=>1,title=>""},with=>'lines',sequence(3,3)); };
|
| 843 | 727 |
is($@, '', "3-d grid plot with single column succeeded");
|
| 844 | 728 |
open FOO,"<$testoutput";
|
| 845 | |
$lines = join("",<FOO>);
|
|
729 |
my $lines = join("",<FOO>);
|
| 846 | 730 |
close FOO;
|
| 847 | |
|
|
731 |
|
| 848 | 732 |
eval { $w->plot({trid=>1,title=>"",yr=>[-1,1]},with=>'lines',cdim=>1,sequence(3,3));};
|
| 849 | 733 |
is($@, '', "3-d threaded plot with single column succeeded");
|
| 850 | 734 |
open FOO,"<$testoutput";
|
| 851 | |
$lines2 = join("",<FOO>);
|
|
735 |
my $lines2 = join("",<FOO>);
|
| 852 | 736 |
close FOO;
|
| 853 | |
|
| 854 | |
ok( $lines2 ne $lines, "the two 3-D plots differ");
|
|
737 |
|
|
738 |
isnt( $lines2, $lines, "the two 3-D plots differ");
|
| 855 | 739 |
|
| 856 | 740 |
if( $w->{gp_version} < 5.0 ) {
|
| 857 | |
ok( ($lines2 =~ m/\#/) && ($lines !~ m/\#/) , "the threaded plot has traces the grid lacks");
|
|
741 |
like $lines2, qr/\#/;
|
|
742 |
unlike $lines, qr/\#/, "the threaded plot has traces the grid lacks";
|
| 858 | 743 |
} else {
|
| 859 | 744 |
# 5.0 no longer uses hashes and asterisks to distinguish the lines, so just check that the plot
|
| 860 | 745 |
# changed.
|
| 861 | |
skip "Skipping hash/asterisk test since gnuplot is 5.0 or newer",1;
|
|
746 |
skip "Skipping hash/asterisk test since gnuplot is 5.0 or newer", 2;
|
| 862 | 747 |
}
|
| 863 | 748 |
}
|
| 864 | 749 |
|
|
| 883 | 768 |
|
| 884 | 769 |
eval { $w->options(xrange=>pdl(1,2)) };
|
| 885 | 770 |
is($@, '', "xrange accepts a PDL option");
|
| 886 | |
|
| 887 | |
ok( (ref($w->{options}->{xrange}) eq 'ARRAY' and
|
| 888 | |
$w->{options}->{xrange}->[0] == 1 and
|
| 889 | |
$w->{options}->{xrange}->[1] == 2
|
| 890 | |
),
|
| 891 | |
"xrange parses a 2-PDL into a list ref");
|
|
771 |
is_deeply $w->{options}{xrange}, [1, 2],
|
|
772 |
"xrange parses a 2-PDL into a list ref";
|
| 892 | 773 |
|
| 893 | 774 |
eval { $w->options(xrange=>pdl(1,2,3)) };
|
| 894 | |
ok($@, "xrange rejects a PDL with more than 2 elements");
|
|
775 |
isnt($@, '', "xrange rejects a PDL with more than 2 elements");
|
| 895 | 776 |
|
| 896 | 777 |
eval {$w->options(xrange=>[21]);};
|
| 897 | 778 |
is($@, '', "xrange accepts a single list element");
|
| 898 | |
|
| 899 | |
ok( ( ref($w->{options}->{xrange}) eq 'ARRAY' and
|
| 900 | |
$w->{options}->{xrange}->[0] == 21 and
|
| 901 | |
!defined($w->{options}->{xrange}->[1])
|
| 902 | |
), "xrange parses single list element correctly");
|
|
779 |
is_deeply $w->{options}{xrange}, [21],
|
|
780 |
"xrange parses single list element correctly";
|
| 903 | 781 |
|
| 904 | 782 |
eval { $w->options(justify=>"0") };
|
| 905 | 783 |
is($@, '', "justify accepts quoted zero");
|
| 906 | 784 |
|
| 907 | 785 |
eval { $w->options(justify=>"-1") };
|
| 908 | |
ok($@ =~ m/positive/, "justify rejects negative numbers");
|
|
786 |
like($@, qr/positive/, "justify rejects negative numbers");
|
| 909 | 787 |
undef $@;
|
| 910 | 788 |
|
| 911 | 789 |
eval { $w->options(justify=>"1") };
|
|
| 923 | 801 |
eval { $w->plot(with=>'lines',xvals(5)) };
|
| 924 | 802 |
is($@, '', "ascii plot with implicit col succeeded");
|
| 925 | 803 |
|
| 926 | |
ok($PDL::Graphics::Gnuplot::last_plotcmd =~ m/plot +\'\-\' +using 0\:1 /,
|
|
804 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/plot +\'\-\' +using 0\:1 /,
|
| 927 | 805 |
"ascii plot with implicit col uses explicit reference to column 0");
|
| 928 | 806 |
|
| 929 | 807 |
eval { $w->plot(with=>'lines',xvals(5),xvals(5)) };
|
| 930 | 808 |
is($@, '', "ascii plot with no implicit col succeeded");
|
| 931 | |
ok($PDL::Graphics::Gnuplot::last_plotcmd =~ m/plot +\'\-\' +using 1\:2 /s,
|
|
809 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/plot +\'\-\' +using 1\:2 /s,
|
| 932 | 810 |
"ascii plot with no implicit cols uses columns 1 and 2");
|
| 933 | 811 |
|
| 934 | 812 |
eval { $w->plot(with=>'lines',xvals(5,5)) };
|
| 935 | 813 |
is($@, '', "ascii plot with threaded data and implicit column succeeded");
|
| 936 | |
ok($PDL::Graphics::Gnuplot::last_plotcmd =~ m/plot +\'-\' +using 0\:1 [^u]+using 0\:1 /s,
|
|
814 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/plot +\'-\' +using 0\:1 [^u]+using 0\:1 /s,
|
| 937 | 815 |
"threaded ascii plot with one implicit col does the Right Thing");
|
| 938 | 816 |
|
| 939 | 817 |
|
| 940 | 818 |
eval { $w->plot(with=>'lines',xvals(5),{trid=>1}) };
|
| 941 | 819 |
is($@, '', "ascii 3-d plot with 2 implicit cols succeeded");
|
| 942 | |
ok($PDL::Graphics::Gnuplot::last_plotcmd =~ m/plot +\'-' +using 0\:\(\$0\*0\)\:1 /s,
|
|
820 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/plot +\'-' +using 0\:\(\$0\*0\)\:1 /s,
|
| 943 | 821 |
"ascii plot with two implicit cols uses column 0 and zeroed-out column 0");
|
| 944 | 822 |
|
| 945 | 823 |
eval { $w->plot(with=>'lines',xvals(5),xvals(5),{trid=>1})};
|
| 946 | |
ok($@, "ascii 3-d plot with 1 implicit col fails (0 or 2 only)");
|
|
824 |
isnt($@, '', "ascii 3-d plot with 1 implicit col fails (0 or 2 only)");
|
| 947 | 825 |
|
| 948 | 826 |
eval { $w->plot(with=>'lines',xvals(5),xvals(5),xvals(5),{trid=>1}) };
|
| 949 | 827 |
is($@, '', "ascii 3-d plot with no implicit cols succeeds");
|
| 950 | |
ok($PDL::Graphics::Gnuplot::last_plotcmd=~ m/plot +\'-\' +using 1\:2\:3 /s,
|
|
828 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/plot +\'-\' +using 1\:2\:3 /s,
|
| 951 | 829 |
"ascii 3-d plot with no implicit cols does the Right Thing");
|
| 952 | 830 |
|
| 953 | 831 |
eval { $w->plot(with=>'lines',xvals(5,5),{trid=>1}) };
|
| 954 | 832 |
is($@, '', "ascii 3-d plot with 2-D data and 2 implicit cols succeeded");
|
| 955 | |
ok($PDL::Graphics::Gnuplot::last_plotcmd =~ m/splot +\"-\" binary array\=\(5,5\) /s,
|
|
833 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/splot +\"-\" binary array\=\(5,5\) /s,
|
| 956 | 834 |
"ascii plot with 2-D data and 2 implicit cols uses binary ARRAY mode");
|
| 957 | 835 |
|
| 958 | 836 |
eval { $w->plot(with=>'lines',xvals(5,5),xvals(5,5),{trid=>1}) };
|
| 959 | |
ok($@, "ascii 3-d plot with 2-D data and 1 implicit col fails (0 or 2 only)");
|
|
837 |
isnt($@, '', "ascii 3-d plot with 2-D data and 1 implicit col fails (0 or 2 only)");
|
| 960 | 838 |
|
| 961 | 839 |
eval { $w->plot(with=>'lines',xvals(5,5),xvals(5,5),xvals(5,5),{trid=>1}) };
|
| 962 | 840 |
is($@, '', "ascii 3-d plot with 2-D data and no implicit cols succeeded");
|
| 963 | |
ok($PDL::Graphics::Gnuplot::last_plotcmd =~ m/splot +\"-\" binary record\=\(5,5\) /s,
|
|
841 |
like($PDL::Graphics::Gnuplot::last_plotcmd, qr/splot +\"-\" binary record\=\(5,5\) /s,
|
| 964 | 842 |
"ascii plot with 2-D data and no implicit cols uses binary RECORD mode");
|
| 965 | 843 |
|
| 966 | 844 |
eval { $w->plot(with=>'yerrorbars', (xvals(50)-25)**2, pdl(0.5),{binary=>0}) };
|
|
| 978 | 856 |
|
| 979 | 857 |
open FOO, "<$testoutput";
|
| 980 | 858 |
@lines = <FOO>;
|
| 981 | |
ok( ( (length($lines[12]) != 0) and (substr($lines[12],20,40) =~ m/^\s+$/) ), "NaN makes a blank in a plot");
|
|
859 |
isnt $lines[12], '';
|
|
860 |
like substr($lines[12],20,40), qr/^\s+$/, "NaN makes a blank in a plot";
|
| 982 | 861 |
|
| 983 | 862 |
$w->restart;
|
| 984 | 863 |
$w->plot(with=>'lines',$b,{binary=>1});
|
| 985 | 864 |
$w->close;
|
| 986 | 865 |
open FOO, "<$testoutput";
|
| 987 | 866 |
@lines = <FOO>;
|
| 988 | |
ok( ( (length($lines[12]) != 0) and !(substr($lines[12],20,40) =~ m/^\s+$/) ), "No NaN makes a nonblank in a plot");
|
|
867 |
isnt $lines[12], '';
|
|
868 |
unlike substr($lines[12],20,40), qr/^\s+$/, "No NaN makes a nonblank in a plot";
|
| 989 | 869 |
|
| 990 | 870 |
$w->restart;
|
| 991 | 871 |
$w->plot(with=>'lines',$b,{binary=>0});
|
| 992 | 872 |
$w->close;
|
| 993 | 873 |
open FOO, "<$testoutput";
|
| 994 | 874 |
@lines = <FOO>;
|
| 995 | |
ok( ( (length($lines[12]) != 0) and !(substr($lines[12],20,40) =~ m/^\s+$/) ), "No NaN makes a nonblank in a plot even with ASCII");
|
|
875 |
isnt $lines[12], '';
|
|
876 |
unlike substr($lines[12],20,40), qr/^\s+$/, "No NaN makes a nonblank in a plot even with ASCII";
|
| 996 | 877 |
|
| 997 | 878 |
$w->restart;
|
| 998 | 879 |
$w->plot(with=>'lines',$a,{binary=>0});
|
| 999 | 880 |
$w->close;
|
| 1000 | 881 |
open FOO, "<$testoutput";
|
| 1001 | 882 |
@lines = <FOO>;
|
| 1002 | |
ok( ( (length($lines[12]) != 0) and (substr($lines[12],20,40) =~ m/^\s+$/) ), "NaN makes a blank in a plot even with ASCII");
|
|
883 |
isnt $lines[12], '';
|
|
884 |
like substr($lines[12],20,40), qr/^\s+$/, "NaN makes a blank in a plot even with ASCII";
|
| 1003 | 885 |
|
| 1004 | 886 |
# Test plotting of PDL subclasses
|
| 1005 | 887 |
@MyPackage::ISA = qw/PDL/;
|
|
| 1008 | 890 |
eval { $w->plot( $a ); };
|
| 1009 | 891 |
is $@, '', "subclass of PDL plots OK";
|
| 1010 | 892 |
|
| 1011 | |
# Test terminal defaulting
|
|
893 |
# Test terminal defaulting
|
| 1012 | 894 |
eval { $w=PDL::Graphics::Gnuplot::new(size=>[9,9]); undef($w);};
|
| 1013 | 895 |
is $@, '', "default terminal is selected OK";
|
| 1014 | 896 |
|
|
| 1024 | 906 |
print STDERR "\n***********\nSkipping default-plot-output tests: files 'Plot-1.txt' and/or 'Plot-2.txt' exist.\n***********\n";
|
| 1025 | 907 |
skip "Plot-1.txt and/or Plot-2.txt exist, can't check default plotting", 4;
|
| 1026 | 908 |
}
|
| 1027 | |
|
| 1028 | |
$w=gpwin(dumb);
|
|
909 |
$w=gpwin('dumb');
|
| 1029 | 910 |
eval { $w->line(xvals(20)**3); };
|
| 1030 | |
ok( !$@, "default-output plot succeeded" );
|
|
911 |
is( $@, '', "default-output plot succeeded" );
|
| 1031 | 912 |
ok( -e "Plot-1.txt", "Plot got made" );
|
| 1032 | 913 |
eval { $w->line(xvals(10)**4); };
|
| 1033 | |
ok (!$@, "default-output plot succeeded again");
|
|
914 |
is($@, '', "default-output plot succeeded again");
|
| 1034 | 915 |
ok( -e "Plot-2.txt", "Second plot got made" );
|
| 1035 | 916 |
unlink "Plot-1.txt";
|
| 1036 | 917 |
unlink "Plot-2.txt";
|