tests/falsecolor_test.pl
author Axel Jacobs <axel@jaloxa.eu>
Sun, 26 Jun 2011 21:32:00 +0100
changeset 16 7174511d4983
child 17 e4ebb10e4697
permissions -rw-r--r--
Added test script for falsecolor.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
16
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     1
#!/usr/bin/perl
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     2
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     3
use strict;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     4
use warnings;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     5
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     6
my $script = "falsecolor";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     7
my $csh = "../orig/falsecolor.csh";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     8
my $perl = "../bin/falsecolor.perl";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
     9
print "script: $script\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    10
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    11
use File::Temp qw/ tempdir /;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    12
my $tmpdir = tempdir( CLEANUP => 0 );
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    13
print "temp dir: $tmpdir\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    14
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    15
my $img = "data/images/street-rgbe_rle_400x400.hdr";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    16
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    17
my @options = (
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    18
		"-ip $img",
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    19
		"-ip $img -l cd/m2",   # Label now defaults to cd/m2, not nits.
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    20
		"-i $img -p $img -l cd/m2",
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    21
		"-ip $img -cl -l cd/m2",
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    22
		"-ip $img -n 10 -l cd/m2",
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    23
		"-ip $img -s 2000 -l cd/m2",
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    24
		"-ip $img -lw 200 -lh 300 -l cd/m2",   # scale is slightly higher now.
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    25
);
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    26
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    27
# Run old CSH and new Perl script with different options,
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    28
# compare the resulting images.
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    29
my $index = 0;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    30
my $opt;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    31
foreach $opt (@options) {
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    32
		my $cshout = "$tmpdir/${script}_csh$index.hdr";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    33
		my $cshcmd = "$script.csh $opt > $cshout";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    34
		print "  $cshcmd\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    35
		system "csh ../orig/$cshcmd";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    36
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    37
		my $perlout = "$tmpdir/${script}_perl$index.hdr";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    38
		my $perlcmd = "$script.pl $opt > $perlout";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    39
		print "  $perlcmd\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    40
		system "perl ../bin/$perlcmd";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    41
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    42
		my $diffimg = "$tmpdir/${script}_diff$index.hdr";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    43
		my $uval = &compare_images("$cshout", "$perlout", "$diffimg");
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    44
		if( $uval > 0 ) {
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    45
			print "      Error: Diff image $diffimg contains $uval unique values (should be one).\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    46
			system "ximage $diffimg";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    47
		} else {
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    48
			print "      Ok: Images $cshout and $perlout are identical.\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    49
		}
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    50
}
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    51
print "temp dir $tmpdir not removed. Please remove manually.\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    52
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    53
sub compare_images() {
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    54
	my $in1 = shift;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    55
	my $in2 = shift;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    56
	my $out = shift;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    57
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    58
	my $cmd = "pcomb $in1 -s -1 $in2 > $out";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    59
	print "    $cmd\n";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    60
	system "$cmd";
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    61
	my $unique = `pvalue -h -H -d -u $out`;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    62
	my $unique_cnt = scalar( split( '\n', $unique ) );
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    63
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    64
	return $unique_cnt;
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    65
}
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    66
7174511d4983 Added test script for falsecolor.
Axel Jacobs <axel@jaloxa.eu>
parents:
diff changeset
    67
#EOF