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