File: test_helper.pl

package info (click to toggle)
libtest-spec-perl 0.47-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 248 kB
  • ctags: 166
  • sloc: perl: 2,190; makefile: 2
file content (72 lines) | stat: -rw-r--r-- 2,101 bytes parent folder | download | duplicates (5)
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
65
66
67
68
69
70
71
72
use strict;
use FindBin qw($Bin);

#
# Shim to make Win32 behave during the test suite.
#
# Using fork+exec causes an APPCRASH during show_exceptions.t. Simply
# reopening STDOUT and STDERR to the same duped filehandle causes errors in
# the output where STDOUT and STDERR are written on top of each other (even
# when autoflush is turned on). Reopening STDERR on top of STDOUT in the child
# process seems to fix this problem.
open(STDERR, ">&STDOUT") || die "can't reopen STDERR on STDOUT: $!";


{
  package SpecStub;
  sub new { bless do { \my $stub }, shift() }
  sub AUTOLOAD { shift }
}

sub stub_builder_in_packages {
  my $code = pop;
  my @packages = @_ ? @_ : 'A';
  push @packages, 'Test::More';

  my $stub = SpecStub->new;
  my @locals = map { "local *${_}::builder = sub { \$stub };" } @packages;

  local $, = " ";
  eval "@locals; \$code->()";
  die $@ if $@;
}

sub capture_tap {
  my ($spec_name,@args) = @_;

  require File::Spec;
  require File::Temp;
  my ($fh,$filename) = File::Temp::tempfile('tmpfileXXXXXX', TMPDIR => 1);
  close($fh);

  open my $oldout, ">&STDOUT" or die "can't dup stdout: $!";
  open my $olderr, ">&STDERR" or die "can't dup stderr: $!";
  open(STDOUT, ">", $filename) || die "can't open '$filename' for out: $!";
  open(STDERR, ">&STDOUT")     || die "can't reopen stderr on stdout: $!";

  system($^X, (map { "-I$_" } @INC), File::Spec->catfile($Bin, $spec_name), @args);

  open(STDERR, ">&", $olderr) || do {
    print {$olderr} "can't reopen stderr: $! " .  "at " . __FILE__ . " line " .  __LINE__ . "\n";
    exit(1);
  };
  open(STDOUT, ">&", $oldout) || die "can't reopen stdout: $!";
  open($fh, "<", $filename) || die "can't open '$filename' for read: $!";
  my $tap = do { local $/; <$fh> };
  unlink($filename) || warn "can't unlink '$filename': $!";
  return $tap;
}

sub parse_tap {
  require TAP::Parser;
  my ($spec_name,@args) = @_;
  my $tap = capture_tap($spec_name,@args);
  my $parser = TAP::Parser->new({ tap => $tap });
  my @results;
  while (my $result = $parser->next) {
    push @results, $result;
  }
  return @results;
}

1;