1# -*-perl-*- 2BEGIN{ 3 # Set perl to not try to resolve all symbols at startup 4 # The default behavior causes some problems because 5 # the PGPLOT code defines interfaces for all PGPLOT functions 6 # whether or not they are linked. 7 $ENV{'PERL_DL_NONLAZY'}=0; 8} 9 10use strict; 11 12use PDL; 13use Test::More; 14 15BEGIN{ 16 eval "use PDL::Graphics::PGPLOT; use PDL::Graphics::PGPLOT::Window;"; 17 if ($@) { 18 plan skip_all => "PDL::Graphics::PGPLOT not installed"; 19 } elsif ( !exists($ENV{'DISPLAY'}) and !exists($ENV{HARNESS_ACTIVE}) ) { 20 # We have this after the PGPLOT module is loaded so that we test whether the 21 # module will at least load, even if we do not test it's 22 # functionality. 23 # 24 plan tests => 1; 25 pass("use ok for PGPLOT PDL modules # skip -- DISPLAY environment variable not set"); 26 exit; 27 } else { 28 plan tests => 12; 29 } 30} 31 32sub get_answer () { 33 print STDERR "Does this look OK (y/n, y is default)? :"; 34 my $answer = <STDIN>; 35 return $answer !~ m/n/i; 36} 37 38sub interactive ($$) { 39 my $flag = shift; 40 my $num = shift; 41 return unless $flag; # ie not interactive 42 43 if (1 == $num) { 44 print STDERR <<'EOD'; 45PGPLOT X device... you should see a 6 inch (153 mm) x 4 inch (102 mm) 46X window with four plots in it. All four images should have tick marks 47on the outside of the axes. 48 49[ Scaled image of m51; scale [Scaled image of m51 with scale from 50 in pixels on both axes ] X=[-1.8, 2.0],Y=[-1.9, 1.9] arcmin, 51 with cal. wedge, centered in rect. frame] 52 53[ Square image of m51; scale [Square image of m51 with scale as above, 54 in pixels on both axes; ``shrink-wrapped''] 55 ``shrinkwrapped'' ] 56 57EOD 58 } elsif (2 == $num) { 59 print STDERR <<'EOD'; 60============================================================== 61 62You should see four plots demonstrating pitch setting, justification, 63and alignment: 64 65[ Square image of m51 scaled to [Short, squat image of m51 with 66300 ppi (1.25 inches wide), aligned aspect ratio 1:2, width 1.25 inch, 67to bottom left corner of rect. plot and height 0.625 inch, shrinkwrapped 68box and cropped at the top. ] and placed at lower left of plot rgn] 69 70[ Square image of m51 scaled to [Tall, narrow image of m51 with 71300 ppi (1.25 inches wide), aligned aspect ratio 2:1, width 0.625 inch, 72to upper right corner of rect. plot and height 1.25 inch, shrinkwrapped 73box and cropped at the bottom. ] and placed at upper right of plot rgn] 74 75EOD 76 } else { 77 die "Internal error: unknown test number $num for interactive()!\n"; 78 } 79 return get_answer(); 80} 81 82my $interactive = exists($ENV{'PDL_INT'}); 83my $skip_interactive_msg = "interactive tests not run since environment var PDL_INT not set"; 84my $interactive_ctr = 0; 85 86### 87### Test code 88### 89 90my $dev = $ENV{'PGPLOT_DEV'} ? $ENV{'PGPLOT_DEV'} : "/xw"; 91 92$dev = '/null' if exists $ENV{HARNESS_ACTIVE}; 93 94my $w = PDL::Graphics::PGPLOT::Window->new( 95 Dev => $dev, 96 Size=> [6,4], 97 NX=>2, NY=>2, 98 Ch=>2.5, HardCH=>2.5); 99ok( UNIVERSAL::isa($w, "PDL::Graphics::PGPLOT::Window") ); 100 101my $a = rfits('m51.fits'); 102 103############################## 104# Page 1 105# 106foreach my $str ( ( 107 '$w->imag($a,{Title=>"\$w->imag(\$a);"} );', 108 '$w->fits_imag($a,{Title=>"\$w->fits_imag(\$a);"});', 109 '$w->imag($a,{J=>1,Title=>"\$w->imag(\$a,{J=>1});"});', 110 '$w->fits_imag($a,{J=>1,Title=>"\$w->fits_imag(\$a,{J=>1});"});' 111 ) ) { 112 eval $str; 113 ok (!$@); 114} 115 116$interactive_ctr++; 117SKIP: { 118 skip $skip_interactive_msg, 1 unless $interactive; 119 ok(interactive($interactive, $interactive_ctr), "interactive tests"); 120} 121 122############################## 123# Page 2 124# 125foreach my $str ( ( 126 '$w->imag($a,{Pitch=>300,Align=>"LB",Title=>"\$w->imag(\$a,{Pitch=>300,Align=>LB})"});', 127 '$w->imag($a,{J=>.5,Pitch=>300,Align=>"LB",Title=>"\$w->imag(\$a,{J=>.5,Pitch=>300,Align=>LB})"});', 128 '$w->imag($a,{Pitch=>300,Align=>"RT",Title=>"\$w->imag(\$a,{Pitch=>300,Align=>RT})"});', 129 '$w->imag($a,{J=>2,Pitch=>600,Align=>"RT",Title=>"\$w->imag(\$a,{J=>2,Pitch=>600,Align=>RT}) ."});', 130 ) ) { 131 eval $str; 132 ok (!$@); 133} 134 135$interactive_ctr++; 136SKIP: { 137 skip $skip_interactive_msg, 1 unless $interactive; 138 ok(interactive($interactive, $interactive_ctr), "interactive tests"); 139} 140 141eval '$w->close'; 142ok (!$@); 143 144# End 145 146 147