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