Added test script for falsecolor.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/falsecolor_test.pl Sun Jun 26 21:32:00 2011 +0100
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $script = "falsecolor";
+my $csh = "../orig/falsecolor.csh";
+my $perl = "../bin/falsecolor.perl";
+print "script: $script\n";
+
+use File::Temp qw/ tempdir /;
+my $tmpdir = tempdir( CLEANUP => 0 );
+print "temp dir: $tmpdir\n";
+
+my $img = "data/images/street-rgbe_rle_400x400.hdr";
+
+my @options = (
+ "-ip $img",
+ "-ip $img -l cd/m2", # Label now defaults to cd/m2, not nits.
+ "-i $img -p $img -l cd/m2",
+ "-ip $img -cl -l cd/m2",
+ "-ip $img -n 10 -l cd/m2",
+ "-ip $img -s 2000 -l cd/m2",
+ "-ip $img -lw 200 -lh 300 -l cd/m2", # scale is slightly higher now.
+);
+
+# Run old CSH and new Perl script with different options,
+# compare the resulting images.
+my $index = 0;
+my $opt;
+foreach $opt (@options) {
+ my $cshout = "$tmpdir/${script}_csh$index.hdr";
+ my $cshcmd = "$script.csh $opt > $cshout";
+ print " $cshcmd\n";
+ system "csh ../orig/$cshcmd";
+
+ my $perlout = "$tmpdir/${script}_perl$index.hdr";
+ my $perlcmd = "$script.pl $opt > $perlout";
+ print " $perlcmd\n";
+ system "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";
+ } else {
+ print " Ok: Images $cshout and $perlout are identical.\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