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