summaryrefslogtreecommitdiff
path: root/Build/source/texk/tests/common-test.pl
blob: c936f24f656f57f42960736870b92f8e20d6868a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
# $Id: common-test.pl 16695 2010-01-13 01:18:02Z karl $
# Public domain.  Originally written 2010, Karl Berry.
# Common definitions for Perl tests in TeX Live.  We want to use Perl to
# have a chance of running the tests on Windows.

# absolute path
chomp (my $TL_TESTS_DIR = `cd "$srcdir/../tests" && pwd`);

# srcdir must be a sibling dir to kpathsea, e.g., web2c.
$ENV{"TEXMFCNF"} = "$srcdir/../kpathsea";
$ENV{"AFMFONTS"}
  = $ENV{"BIBINPUTS"}
  = $ENV{"BSTINPUTS"}
  = $ENV{"TEXINPUTS"}
  = ".:$srcdir/tests:$srcdir/../tests/texmf//";


# Run PROG with ARGS.  Return the exit status.
# Die if PROG is not executable.
#
sub test_run {
  my ($prog, @args) = @_;

  # Possibly we should check that $prog starts with ./, since we always
  # want to run out of the build dir.  I think.
  die "$0: no program $prog in " . `pwd` if ! -x $prog;
  
  # use local pm files and kpsewhich.
  $ENV{"PERL5LIB"} = $TL_TESTS_DIR;
  $ENV{"PATH"} = "../kpathsea:$ENV{PATH}";

  # Won't be copyable with weird names, but should get the info across.
  print "$0: running ", $prog, " ", join (" ", @args), "\n";
  
  # Run it.
  my $ret = system ($prog, @args);  
  return $ret;
}

sub test_file_copy {
  my ($srcfile,$dstfile) = @_;
  
  # don't copy onto itself.
  chomp (my $srcdir = `dirname $srcfile`);
  chomp ($srcdir = `cd $srcdir && pwd`);
  #
  chomp (my $dstdir = `dirname $dstfile`);
  chomp ($dstdir = `cd $dstdir && pwd`);
  return if $srcdir eq $dstdir;
  
  local *IN;
  $IN = "<$srcfile";
  open (IN) || die "open($srcfile) failed: $!";
  my @in = <IN>;
  close (IN) || warn "close($srcfile) failed: $!";
  
  local *OUT;
  $OUT = ">$dstfile";
  open (OUT) || die "open($dstfile) failed: $!";
  print (OUT @in) || die "print($dstfile) failed: $!";
  close (OUT) || warn "close($dstfile) failed: $!";
  
  return 0;
}