|
1 #!/usr/bin/perl |
|
2 |
|
3 # pdelta_test.pl |
|
4 # This file is part of the testsuite of the Radiance csh2perl project. |
|
5 # You may copy and modify this file as basis for other tests. |
|
6 # |
|
7 # (c) Axel Jacobs, 28 June 2011 |
|
8 |
|
9 use strict; |
|
10 use warnings; |
|
11 |
|
12 my $script = "pdelta"; |
|
13 my $csh = "../orig/$script.csh"; |
|
14 my $perl = "../bin/$script.perl"; |
|
15 print "script: $script\n"; |
|
16 |
|
17 use File::Temp qw/ tempdir /; |
|
18 my $tmpdir = tempdir( CLEANUP => 0 ); |
|
19 |
|
20 my $img1 = "data/images/street-rgbe_rle_400x400.hdr"; |
|
21 my $img2 = "data/images/street2-rgbe_rle_400x400.hdr"; |
|
22 |
|
23 # Options are arrays of [STDIN, command-line options]. |
|
24 # Please include the pipe symbol as part of STDIN. |
|
25 # Put a leading space in front of STDIN to line up the output. |
|
26 my @options = ( |
|
27 ["", "$img1 $img2"], |
|
28 ); |
|
29 |
|
30 # Run old CSH and new Perl script with different options, |
|
31 # compare the resulting images. |
|
32 my $total = 0; |
|
33 my $fail = 0; |
|
34 my $index = 0; |
|
35 my $opts; |
|
36 foreach $opts (@options) { |
|
37 my $stdin = @$opts[0]; |
|
38 my $args = @$opts[1]; |
|
39 $total++; |
|
40 |
|
41 my $cshout = "$tmpdir/${script}_csh$index.hdr"; |
|
42 my $cshcmd = "$script.csh $args > $cshout"; |
|
43 print " $stdin $cshcmd\n"; |
|
44 system "$stdin csh ../orig/$cshcmd"; |
|
45 |
|
46 my $perlout = "$tmpdir/${script}_perl$index.hdr"; |
|
47 my $perlcmd = "$script.pl $args > $perlout"; |
|
48 print " $stdin $perlcmd\n"; |
|
49 system "$stdin perl ../bin/$perlcmd"; |
|
50 |
|
51 my $diffimg = "$tmpdir/${script}_diff$index.hdr"; |
|
52 my $uval = &compare_images("$cshout", "$perlout", "$diffimg"); |
|
53 if( $uval > 0 ) { |
|
54 print " Error: Diff image $diffimg contains $uval unique values (should be one).\n"; |
|
55 system "ximage $diffimg"; |
|
56 $fail++; |
|
57 } else { |
|
58 print " Ok: Images $cshout and $perlout are identical.\n"; |
|
59 } |
|
60 } |
|
61 |
|
62 print "$fail of $total tests failed.\n"; |
|
63 print "temp dir $tmpdir not removed. Please remove manually.\n"; |
|
64 |
|
65 sub compare_images() { |
|
66 my $in1 = shift; |
|
67 my $in2 = shift; |
|
68 my $out = shift; |
|
69 |
|
70 my $cmd = "pcomb $in1 -s -1 $in2 > $out"; |
|
71 print " $cmd\n"; |
|
72 system "$cmd"; |
|
73 my $unique = `pvalue -h -H -d -u $out`; |
|
74 my $unique_cnt = scalar( split( '\n', $unique ) ); |
|
75 |
|
76 return $unique_cnt; |
|
77 } |
|
78 |
|
79 #EOF |