|
19
|
1 |
#!/usr/bin/perl
|
|
|
2 |
|
|
|
3 |
# objpict_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, 26 June 2011
|
|
|
8 |
|
|
|
9 |
use strict;
|
|
|
10 |
use warnings;
|
|
|
11 |
|
|
|
12 |
my $script = "objpict";
|
|
|
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 $object = "data/objects/mybox.rad";
|
|
|
21 |
my $material = "data/objects/objects.mat";
|
|
|
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 |
["", "$material $object"],
|
|
|
28 |
[" cat $material $object |", ""],
|
|
|
29 |
);
|
|
|
30 |
|
|
|
31 |
# Run old CSH and new Perl script with different options,
|
|
|
32 |
# compare the resulting images.
|
|
|
33 |
my $total = 0;
|
|
|
34 |
my $fail = 0;
|
|
|
35 |
my $index = 0;
|
|
|
36 |
my $opts;
|
|
|
37 |
foreach $opts (@options) {
|
|
|
38 |
my $stdin = @$opts[0];
|
|
|
39 |
my $args = @$opts[1];
|
|
|
40 |
$total++;
|
|
|
41 |
|
|
|
42 |
my $cshout = "$tmpdir/${script}_csh$index.hdr";
|
|
|
43 |
my $cshcmd = "$script.csh $args > $cshout";
|
|
|
44 |
print " $stdin $cshcmd\n";
|
|
|
45 |
system "$stdin csh ../orig/$cshcmd";
|
|
|
46 |
|
|
|
47 |
my $perlout = "$tmpdir/${script}_perl$index.hdr";
|
|
|
48 |
my $perlcmd = "$script.pl $args > $perlout";
|
|
|
49 |
print " $stdin $perlcmd\n";
|
|
|
50 |
system "$stdin perl ../bin/$perlcmd";
|
|
|
51 |
|
|
|
52 |
my $diffimg = "$tmpdir/${script}_diff$index.hdr";
|
|
|
53 |
my $uval = &compare_images("$cshout", "$perlout", "$diffimg");
|
|
|
54 |
if( $uval > 0 ) {
|
|
|
55 |
print " Error: Diff image $diffimg contains $uval unique values (should be one).\n";
|
|
|
56 |
system "ximage $diffimg";
|
|
|
57 |
$fail++;
|
|
|
58 |
} else {
|
|
|
59 |
print " Ok: Images $cshout and $perlout are identical.\n";
|
|
|
60 |
}
|
|
|
61 |
}
|
|
|
62 |
|
|
|
63 |
print "$fail of $total tests failed.\n";
|
|
|
64 |
print "temp dir $tmpdir not removed. Please remove manually.\n";
|
|
|
65 |
|
|
|
66 |
sub compare_images() {
|
|
|
67 |
my $in1 = shift;
|
|
|
68 |
my $in2 = shift;
|
|
|
69 |
my $out = shift;
|
|
|
70 |
|
|
|
71 |
my $cmd = "pcomb $in1 -s -1 $in2 > $out";
|
|
|
72 |
print " $cmd\n";
|
|
|
73 |
system "$cmd";
|
|
|
74 |
my $unique = `pvalue -h -H -d -u $out`;
|
|
|
75 |
my $unique_cnt = scalar( split( '\n', $unique ) );
|
|
|
76 |
|
|
|
77 |
return $unique_cnt;
|
|
|
78 |
}
|
|
|
79 |
|
|
|
80 |
#EOF
|