tests/pdelta_test.pl
author Axel Jacobs <axel@jaloxa.eu>
Mon, 14 Apr 2014 22:21:35 +0100
changeset 74 196d637b14b5
parent 29 1d4a7742ba50
permissions -rw-r--r--
New Radiance fitting with spaces in file name
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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