8 my $perl = "../bin/falsecolor.perl"; |
14 my $perl = "../bin/falsecolor.perl"; |
9 print "script: $script\n"; |
15 print "script: $script\n"; |
10 |
16 |
11 use File::Temp qw/ tempdir /; |
17 use File::Temp qw/ tempdir /; |
12 my $tmpdir = tempdir( CLEANUP => 0 ); |
18 my $tmpdir = tempdir( CLEANUP => 0 ); |
13 print "temp dir: $tmpdir\n"; |
|
14 |
19 |
15 my $img = "data/images/street-rgbe_rle_400x400.hdr"; |
20 my $img = "data/images/street-rgbe_rle_400x400.hdr"; |
16 |
21 |
|
22 # Options are arrays of [STDIN, command-line options]. |
|
23 # Please include the pipe symbol as part of STDIN. |
|
24 # Put a leading space in front of STDIN to line up the output. |
17 my @options = ( |
25 my @options = ( |
18 "-ip $img", |
26 ["", "-ip $img"], |
19 "-ip $img -l cd/m2", # Label now defaults to cd/m2, not nits. |
27 ["", "-ip $img -l cd/m2"], # Label now defaults to cd/m2, not nits. |
20 "-i $img -p $img -l cd/m2", |
28 ["", "-i $img -p $img -l cd/m2"], |
21 "-ip $img -cl -l cd/m2", |
29 ["", "-ip $img -cl -l cd/m2"], |
22 "-ip $img -n 10 -l cd/m2", |
30 ["", "-ip $img -n 10 -l cd/m2"], |
23 "-ip $img -s 2000 -l cd/m2", |
31 ["", "-ip $img -s 2000 -l cd/m2"], |
24 "-ip $img -lw 200 -lh 300 -l cd/m2", # scale is slightly higher now. |
32 [" cat $img |", "-ip - -s 2000 -l cd/m2"], # take image from STDIN. |
|
33 ["", "-ip $img -lw 200 -lh 300 -l cd/m2"], # scale is slightly higher now. |
25 ); |
34 ); |
26 |
35 |
27 # Run old CSH and new Perl script with different options, |
36 # Run old CSH and new Perl script with different options, |
28 # compare the resulting images. |
37 # compare the resulting images. |
|
38 my $total = 0; |
|
39 my $fail = 0; |
29 my $index = 0; |
40 my $index = 0; |
30 my $opt; |
41 my $opts; |
31 foreach $opt (@options) { |
42 foreach $opts (@options) { |
|
43 my $stdin = @$opts[0]; |
|
44 my $args = @$opts[1]; |
|
45 $total++; |
|
46 |
32 my $cshout = "$tmpdir/${script}_csh$index.hdr"; |
47 my $cshout = "$tmpdir/${script}_csh$index.hdr"; |
33 my $cshcmd = "$script.csh $opt > $cshout"; |
48 my $cshcmd = "$script.csh $args > $cshout"; |
34 print " $cshcmd\n"; |
49 print " $stdin $cshcmd\n"; |
35 system "csh ../orig/$cshcmd"; |
50 system "$stdin csh ../orig/$cshcmd"; |
36 |
51 |
37 my $perlout = "$tmpdir/${script}_perl$index.hdr"; |
52 my $perlout = "$tmpdir/${script}_perl$index.hdr"; |
38 my $perlcmd = "$script.pl $opt > $perlout"; |
53 my $perlcmd = "$script.pl $args > $perlout"; |
39 print " $perlcmd\n"; |
54 print " $stdin $perlcmd\n"; |
40 system "perl ../bin/$perlcmd"; |
55 system "$stdin perl ../bin/$perlcmd"; |
41 |
56 |
42 my $diffimg = "$tmpdir/${script}_diff$index.hdr"; |
57 my $diffimg = "$tmpdir/${script}_diff$index.hdr"; |
43 my $uval = &compare_images("$cshout", "$perlout", "$diffimg"); |
58 my $uval = &compare_images("$cshout", "$perlout", "$diffimg"); |
44 if( $uval > 0 ) { |
59 if( $uval > 0 ) { |
45 print " Error: Diff image $diffimg contains $uval unique values (should be one).\n"; |
60 print " Error: Diff image $diffimg contains $uval unique values (should be one).\n"; |
46 system "ximage $diffimg"; |
61 system "ximage $diffimg"; |
47 } else { |
62 } else { |
48 print " Ok: Images $cshout and $perlout are identical.\n"; |
63 print " Ok: Images $cshout and $perlout are identical.\n"; |
|
64 $fail++; |
49 } |
65 } |
50 } |
66 } |
|
67 |
|
68 print "$fail of $total tests failed.\n"; |
51 print "temp dir $tmpdir not removed. Please remove manually.\n"; |
69 print "temp dir $tmpdir not removed. Please remove manually.\n"; |
52 |
70 |
53 sub compare_images() { |
71 sub compare_images() { |
54 my $in1 = shift; |
72 my $in1 = shift; |
55 my $in2 = shift; |
73 my $in2 = shift; |