Add a couple of helpful perl scripts for valgrind testing.

vdb.pl automates the running of valgrind jobs under gdb, and
multiplexes the output from valgrind and gdb together.

vgbatch.pl automates the running of a list of "cluster like"
tests under valgrind.

2 files changed, 399 insertions, 0 deletions

diff --git a/toolbin/vdb.pl b/toolbin/vdb.pl
new file mode 100644
index 000000000..8555fc1cb
--- /dev/null
+++ b/toolbin/vdb.pl
@@ -0,0 +1,149 @@
+#!/usr/bin/perl
+
+# Perl script to ease the use of gdb with valgrind.
+#
+# Invoke as: vdb.pl <command to run>
+
+use strict;
+use warnings;
+use IPC::Open3;
+use IO::Select;
+
+# Global variables
+my $gdbkilled = 0;
+
+sub killgdb() {
+    if ($gdbkilled) {
+        return;
+    }
+    print GDBSTDIN " \nkill\ny\nquit\n";
+    $gdbkilled = 1;
+}
+
+
+# Store the args
+my @args = @ARGV;
+
+# Make the invocation args for valgrind
+my @vgargs = (
+    "valgrind",
+    "--track-origins=yes",
+    "--vgdb=yes",
+    "--vgdb-error=0" );
+push(@vgargs, @args);
+
+# Make the invocation args for gdb
+my @gdbargs = (
+    "gdb",
+    $args[0]);
+
+# Fork the subprocesses
+my $vgpid = open3(0, \*VGSTDOUT, 0, @vgargs);
+my $gdbpid = open3(\*GDBSTDIN, \*GDBSTDOUT, 0, @gdbargs);
+
+# Cope with Ctrl-C
+sub my_sigint_handler() {
+    print "Caught a SIGINT...\n";
+    if ($gdbkilled) {
+        kill 9, $vgpid;
+        kill 9, $gdbpid;
+        exit(1);
+    }
+    killgdb();
+}
+
+$SIG{'INT'} = \&my_sigint_handler;
+
+my $sel = new IO::Select();
+$sel->add(*VGSTDOUT);
+$sel->add(*GDBSTDOUT);
+$sel->add(*STDIN);
+
+*STDOUT->autoflush();
+
+my $scanning = 1;
+
+sub print_lines($)
+{
+    my $buf=shift;
+
+    while (1) {
+	my $loc = index($buf, "\n");
+	if ($loc < 0) {
+	    last;
+	}
+	my $line = substr($buf, 0, $loc+1);
+	print "$line";
+	$buf = substr($buf, $loc+1);
+    }
+    return $buf;
+}
+
+my $vgpartial = '';
+my $gdbpartial = '';
+my $last2print = 0; # 0 = VG, 1 = GDB
+while (my @ready = $sel->can_read())
+{
+    for my $fh (@ready) {
+        # If valgrind says anything, just print it.
+        if ($fh eq *VGSTDOUT) {
+            my $vgbuf= '';
+            if (sysread(VGSTDOUT, $vgbuf, 64*1024, length($vgbuf)) == 0) {
+                # When valgrind hits EOF, exit.
+                killgdb();
+                waitpid($vgpid,0);
+                waitpid($gdbpid,0);
+                exit(0);
+            }
+            if ($scanning) {
+                $vgbuf =~ m/(target remote \| .+ \-\-pid\=\d+)\s*/;
+                if ($1) {
+                    print GDBSTDIN "$1\n";
+                    $scanning = 0;
+                }
+            }
+	    # It definitely read something, so print it.
+	    if ($last2print == 1) { # Last to print was GDB
+                if ($gdbpartial ne "") { # We need a newline
+		    print "\n";
+		}
+		# Better reprint any partial line we had
+		print "$vgpartial";
+	    }
+            $vgpartial = print_lines($vgbuf);
+	    print "$vgpartial";
+	    $last2print = 0; # VG
+        }
+        # Don't say anything to or from gdb until after we've got the magic words from valgrind
+        if ($scanning == 0) {
+            # Anything the user says, should be parotted to gdb
+            if ($fh eq *STDIN) {
+                my $buf = '';
+                if (sysread(STDIN, $buf, 64*1024, length($buf)) == 0) {
+                    # When the user hits EOF, start to kill stuff.
+                    killgdb();
+                }
+                print GDBSTDIN "$buf";
+            }
+            # Anything gdb says, should be parotted out.
+            if ($fh eq *GDBSTDOUT) {
+		my $gdbbuf='';
+                if (sysread(GDBSTDOUT, $gdbbuf, 64*1024, length($gdbbuf)) == 0) {
+                    # When gdb hits EOF start to kill stuff.
+                    killgdb();
+                }
+		# It definite read something, so print it.
+		if ($last2print == 0) { # Last to print was VG
+		    if ($vgpartial ne "") { # We need a newline
+			print "\n";
+		    }
+		    # Better reprint any partial line we had
+		    print "$gdbpartial";
+		}
+		$gdbpartial = print_lines($gdbbuf);
+		print "$gdbpartial";
+		$last2print = 1; # GDB
+            }
+        }
+    }
+}
diff --git a/toolbin/vgbatch.pl b/toolbin/vgbatch.pl
new file mode 100644
index 000000000..d96321a7e
--- /dev/null
+++ b/toolbin/vgbatch.pl
@@ -0,0 +1,250 @@
+#!/usr/bin/perl
+
+# #include <disclaimer.h>
+# If you speak perl, and are offended by the code herein, I apologise.
+# Please feel free to tidy it up.
+
+# Syntax: vgbatch.pl < <input list>
+
+# Setup steps:
+# 1) Build your binaries ("make vg" or "make debugvg" are good ideas)
+# 2) Edit the paths/options here as appropriate.
+# 3) Save the list of changed files from the local cluster regression email
+# here (e.g. as list.txt).
+# 4) Invoke this script. (e.g. "toolbin/vgbatch.pl < list.txt > vg.out 2>&1 &")
+# 5) While that runs, you can see how far it's gone using: "tail -f vg.out"
+# 6) Make tea. Drink tea.
+#
+# list.txt should look like:
+#
+# tests_private/pdf/PDF_2.0_FTS/fts_01_0108.pdf.ppmraw.300.0 gs ...
+# tests_private/pdf/PDF_2.0_FTS/fts_02_0230.pdf.ppmraw.300.0 gs ...
+# ...
+#
+# Basically this mirrors the list of failed jobs given in a cluster test
+# email.
+
+
+########################################################################
+# SETUP SECTION
+
+# The path to the executables.
+#$gsexe     = "gs/bin/gswin32c.exe";
+$gsexe     = "bin/gs";
+$pclexe    = "bin/gpcl6";
+$xpsexe    = "bin/gxps";
+$gpdlexe   = "bin/gpdl";
+
+# Set the following if you want to override all the tests to use a
+# particular output format/device.
+#$format_override="bmp";
+$format_override="";
+
+# The path from your ghostpdl directory to where the test files can be
+# found
+$fileadjust = "/home/marcos/cluster/";
+
+# END SETUP SECTION
+########################################################################
+
+########################################################################
+# EXTERNAL USES
+use Errno qw(EAGAIN);
+
+########################################################################
+
+########################################################################
+# FUNCTIONS
+
+
+# END FUNCTIONS
+########################################################################
+
+########################################################################
+# Here follows todays lesson. Abandon hope all who enter here. Etc. Etc.
+$basedir      = $ARGV[0];
+$ARGV         = shift @ARGV;
+
+# Now run through the list of files
+$images = 0;
+while (<>)
+{
+    ($path,$exe) = /^(\S+)\s+(\S+)/;
+    ($file,$fmt,$res,$band) = ($path =~ /(\S+)\.(\S+)\.(\d+)\.(\d+)$/);
+
+    $file =~ s/__/\//g;
+    
+    if ($file eq "") {
+        next;
+    }
+
+    # Adjust for the local fs layout
+    $file = $fileadjust.$file;
+
+    # Check the file exists
+    $file2 = "";
+    if (!stat($file))
+    {
+        # Before we give up, consider the possibility that we might need to
+        # pdfwrite it.
+        # Someone who speaks perl can do this more nicely.
+        ($file2) = ($file =~ /(\S+).pdf$/);
+        if (stat($file2))
+        {
+            $exe = "pdfw".$exe;
+	}
+        else
+        {
+            ($file2) = ($file =~ /(\S+).ps$/);
+            if (!stat($file2))
+            {
+                print "Unknown file: ".$file." (".$exe.")\n";
+                next;
+            }
+            $exe = "psw".$exe;
+	}
+    }
+
+    # Avoid doing the same thing twice
+    if ($done{"$file:fmt:$res:$band:$exe"})
+    {
+	print "Repeated test: $file:$fmt:$res:$bad:$exe\n";
+        next;
+    }
+    $done{"$file:$fmt:$res:$band:$exe"} = 1;
+    
+    # Map format to device
+    if ($fmt eq "ppmraw") {
+        $devargs="-sDEVICE=ppmraw";
+        $suffix="ppm";
+    } elsif ($fmt eq "pbmraw") {
+        $devargs="-sDEVICE=pbmraw";
+        $suffix="pbm";
+    } elsif ($fmt eq "pam") {
+        $devargs="-sDEVICE=pam";
+        $suffix="pam";
+    } elsif ($fmt eq "pgmraw") {
+        $devargs="-sDEVICE=pgmraw";
+        $suffix="pgm";
+    } elsif ($fmt eq "pnmcmyk") {
+        $devargs="-sDEVICE=pnmcmyk";
+        $suffix="pnm";
+    } elsif ($fmt eq "pkmraw") {
+        $devargs="-sDEVICE=pkmraw";
+        $suffix="pkm";
+    } elsif ($fmt eq "bmp") {
+        $devargs="-sDEVICE=bmp16m";
+        $suffix="bmp";
+    } elsif ($fmt eq "png") {
+        $devargs="-sDEVICE=png16m";
+        $suffix="png";
+    } elsif ($fmt eq "tiffscaled") {
+        $devargs="-sDEVICE=tiffscaled";
+        $suffix="tif";
+    } elsif ($fmt eq "bitrgb") {
+        $devargs="-sDEVICE=bitrgb";
+        $suffix="bit";
+    } elsif ($fmt eq "bitrgbtags") {
+        $devargs="-sDEVICE=bitrgbtags";
+        $suffix="bit";
+    } elsif ($fmt eq "cups") {
+        $devargs="-sDEVICE=cups";
+        $suffix="cups";
+    } elsif ($fmt eq "plank") {
+        $devargs="-sDEVICE=plank";
+        $suffix="plank";
+    } elsif ($fmt eq "psdcmyk") {
+        $devargs="-sDEVICE=psdcmyk";
+        $suffix="psd";
+    } elsif ($fmt eq "psdcmykog") {
+        $devargs="-sDEVICE=psdcmykog";
+        $suffix="psd";
+    } else {
+        print "Unsupported format $fmt - skipping\n";
+        next;
+    }
+    
+    # Output the title
+    print "=====$path:$exe=====\n";
+
+    my $resargs = " -r$res";
+    my $bandargs = " -dMaxBitmap=400000000";
+    if ($band == 1) {
+	$bandargs = " -dMaxBitmap=1000";
+    }
+    my $randargs = " -Z: -dNOPAUSE -dBATCH -K2000000 -dClusterJob";
+
+    my $binargs;
+    my $psargs = "";
+    if ($file =~ m/\.PS$/) { $psargs = " -dCETMODE"; };
+    if ($exe =~ m/gs/)
+    {
+        $binargs = $gsexe;
+    }
+    elsif ($exe =~ m/pcl/)
+    {
+        $binargs = $pclexe;
+    }
+    elsif ($exe =~ m/xps/)
+    {
+        $binargs = $xpsexe;
+    }
+    elsif ($exe =~ m/gpdl/)
+    {
+        $binargs = $gpdlexe;
+    }
+    else
+    {
+	die "$bin not matched; dying";
+    }
+
+    my $dev1args = $devargs;
+    my $out1args = "/dev/null";
+    my $two_stage = 0;
+    if ($exe =~ m/pdfw/)
+    {
+	$dev1args = "-sDEVICE=pdfwrite";
+	$out1args = "out.pdf";
+	$two_stage = 1;
+    }
+    elsif ($exe =~ m/psw/)
+    {
+	$dev1args = "-sDEVICE=ps2write";
+	$out1args = "out.ps";
+	$two_stage = 1;
+    }
+
+    $cmd = "valgrind --track-origins=yes $binargs $psargs -sOutputFile=$out1args $bandargs $dev1args $resargs $randargs $file2";
+    #system("echo $cmd > out.vg");
+    #system("$cmd >>& out.vg");
+    system("echo $cmd");
+    system("$cmd");
+    my $ret = $?;
+    #system("echo return $ret >> out.vg");
+    system("echo return $ret");
+
+    if ($ret == 0 && $two_stage != 0) {
+	#system("echo ----- >> out.vg");
+	system("echo -----");
+        if ($exe =~ m/pdfw/ ||
+            $exe =~ m/psw/)
+        {
+            $binargs = $gsexe;
+        }
+	else
+	{
+	    die "$exe second stage not matchined; dying";
+	}
+
+	$cmd = "valgrind --track-origins=yes $binargs $psargs -sOutputFile=/dev/null $bandargs $devargs $resargs $randargs $out1args";
+	#system("echo $cmd >> out.vg");
+	#system("$cmd >>& out.vg");
+	system("echo $cmd");
+	system("$cmd");
+	$ret = $?;
+        #system("echo return $ret >> out.vg");
+        system("echo return $ret");
+    }
+}
+
+print "TESTING COMPLETED!\n";