# $Id: test_utils.pl 37595 2007-04-27 18:43:15Z wsnyder $
# DESCRIPTION: Perl ExtUtils: Common routines required by package tests
#
# Copyright 2000-2007 by Wilson Snyder. This program is free software;
# you can redistribute it and/or modify it under the terms of either the GNU
# General Public License or the Perl Artistic License.
use IO::File;
use vars qw($PERL $GCC);
$PERL = "$^X -Iblib/arch -Iblib/lib";
`rm -rf test_dir`;
mkdir 'test_dir',0777;
if (!$ENV{HARNESS_ACTIVE}) {
use lib "blib/lib";
use lib "blib/arch";
use lib "lib";
}
sub run_system {
my $command = shift;
# Run a system command, check errors
print "\t$command\n";
system "$command";
my $status = $?;
($status == 0) or die "%Error: Command Failed $command, $status, stopped";
}
sub run_qx {
my $command = shift;
# Run a backtick system command, check errors
print "\t$command\n";
my $result = qx($command);
my $status = $?;
($status == 0) or die "%Error: Command Failed $command, $status, stopped";
print "\t RESULT: $result\n";
return $result;
}
sub wholefile {
my $file = shift;
my $fh = IO::File->new ($file) or die "%Error: $! $file";
my $wholefile = join('',$fh->getlines());
$fh->close();
return $wholefile;
}
sub files_identical {
my $fn1 = shift;
my $fn2 = shift;
my $f1 = IO::File->new ($fn1) or die "%Error: $! $fn1,";
my $f2 = IO::File->new ($fn2) or die "%Error: $! $fn2,";
my @l1 = $f1->getlines();
my @l2 = $f2->getlines();
my $nl = $#l1; $nl = $#l2 if ($#l2 > $nl);
for (my $l=0; $l<=$nl; $l++) {
if (($l1[$l]||"") ne ($l2[$l]||"")) {
warn ("%Warning: Line ".($l+1)." mismatches; $fn1 != $fn2\n"
."F1: ".($l1[$l]||"*EOF*\n")
."F2: ".($l2[$l]||"*EOF*\n"));
return 0;
}
}
return 1;
}
sub gen_file {
my $filename = shift;
my $datum = shift;
my $fh = IO::File->new($filename,"w") or die;
print $fh "extern int i; int i = $datum;\n";
print $fh "// This is ignored: ",rand(),"\n";
$fh->close();
}
1;
syntax highlighted by Code2HTML, v. 0.9.1