tests/pdelta_test.pl
author Axel Jacobs <axel@jaloxa.eu>
Sun, 01 Dec 2013 23:20:47 +0000
changeset 40 b5bb37a77657
parent 29 1d4a7742ba50
permissions -rw-r--r--
objview: Updated status

#!/usr/bin/perl

# pdelta_test.pl
# This file is part of the testsuite of the Radiance csh2perl project.
# You may copy and modify this file as basis for other tests.
#
# (c) Axel Jacobs, 28 June 2011

use strict;
use warnings;

my $script = "pdelta";
my $csh = "../orig/$script.csh";
my $perl = "../bin/$script.perl";
print "script: $script\n";

use File::Temp qw/ tempdir /;
my $tmpdir = tempdir( CLEANUP => 0 );

my $img1 = "data/images/street-rgbe_rle_400x400.hdr";
my $img2 = "data/images/street2-rgbe_rle_400x400.hdr";

# Options are arrays of [STDIN, command-line options].
# Please include the pipe symbol as part of STDIN.
# Put a leading space in front of STDIN to line up the output.
my @options = (
		["", "$img1 $img2"],
);

# Run old CSH and new Perl script with different options,
# compare the resulting images.
my $total = 0;
my $fail = 0;
my $index = 0;
my $opts;
foreach $opts (@options) {
	my $stdin = @$opts[0];
	my $args = @$opts[1];
	$total++;

	my $cshout = "$tmpdir/${script}_csh$index.hdr";
	my $cshcmd = "$script.csh $args > $cshout";
	print " $stdin $cshcmd\n";
	system "$stdin csh ../orig/$cshcmd";

	my $perlout = "$tmpdir/${script}_perl$index.hdr";
	my $perlcmd = "$script.pl $args > $perlout";
	print " $stdin $perlcmd\n";
	system "$stdin perl ../bin/$perlcmd";

	my $diffimg = "$tmpdir/${script}_diff$index.hdr";
	my $uval = &compare_images("$cshout", "$perlout", "$diffimg");
	if( $uval > 0 ) {
		print "      Error: Diff image $diffimg contains $uval unique values (should be one).\n";
		system "ximage $diffimg";
		$fail++;
	} else {
		print "      Ok: Images $cshout and $perlout are identical.\n";
	}
}

print "$fail of $total tests failed.\n";
print "temp dir $tmpdir not removed. Please remove manually.\n";

sub compare_images() {
	my $in1 = shift;
	my $in2 = shift;
	my $out = shift;

	my $cmd = "pcomb $in1 -s -1 $in2 > $out";
	print "    $cmd\n";
	system "$cmd";
	my $unique = `pvalue -h -H -d -u $out`;
	my $unique_cnt = scalar( split( '\n', $unique ) );

	return $unique_cnt;
}

#EOF