Test-Trap

 view release on metacpan or  search on metacpan

t/03-files.pl  view on Meta::CPAN

  END { close STDERR; close $errfh }
}

sub diagdie {
  my $msg = shift;
  diag $msg;
  die $msg;
}

my ($noise, $noisecounter) = ('', 0);
sub runtests(&@) { # runs the trap and performs 6 tests
  my($code, $return, $warn, $stdout, $stderr, $desc) = @_;
  my $n = ++$noisecounter . $/;
  warn $n or diagdie "Cannot warn()!";
  STDERR->flush or diagdie "Cannot flush STDERR!";
  print STDERR $n or diagdie "Cannot print on STDERR!";
  STDERR->flush or diagdie "Cannot flush STDERR!";
  $noise .= "$n$n";
  $warn = do { local $" = "[^`]*`"; qr/\A@$warn[^`]*\z/ };
  my @r = eval { &trap($code) }; # bypass prototype
  my $e = $@;

t/14-leaks.t  view on Meta::CPAN

use Test::Refcount;

use strict;
use warnings;

use Test::Trap qw/ $tempfile   tempfile   :output(tempfile)   /;
use Test::Trap qw/ $systemsafe systemsafe :output(systemsafe) /;
use Test::Trap qw/ $perlio     perlio     :output(perlio) /;

our($trap);
sub trap(&);
for my $glob (qw(tempfile systemsafe perlio)) {
  no strict 'refs';
  local *trap = *$glob;
  () = trap { 0 };
  is_oneref($trap, "Basic check, with $glob: Our trap has one ref.");
  my $copy = $trap;
  my $prop = $trap->Prop;
  Scalar::Util::weaken($copy);
  Scalar::Util::weaken($prop);
  is_oneref($copy, "Sanity check, with $glob: Our trap has one ref now.");

t/15-tempfile-options.t  view on Meta::CPAN

use Test::Trap::Builder::TempFile latin2 => { io_layers => ':encoding(iso-8859-2)' };
use Test::Trap qw/ $basic    basic    :output(tempfile)          /;
use Test::Trap qw/ $preserve preserve :output(tempfile-preserve) /;
use Test::Trap qw/ $utf8     utf8     :output(utf8)              /;
use Test::Trap qw/ $both     both     :output(both)              /;
use Test::Trap qw/ $latin2   latin2   :output(latin2)            /;

my @layers = qw(basic preserve utf8 both latin2);

our($trap);
sub trap(&);

# For RT #102271:
# The STDOUT may actually have a utf8 layer, from PERL_UNICODE or PERL5OPT or whatever.
# So, check it:
my $original_utf8 = grep { /utf8/ } PerlIO::get_layers(*STDOUT);

# Test 1: Å‚ (l stroke); no messing with STDOUT
for my $glob (@layers) {
  no strict 'refs';
  local *trap = *$glob;

t/16-systemsafe-options.t  view on Meta::CPAN

use Test::Trap::Builder::SystemSafe latin2 => { io_layers => ':encoding(iso-8859-2)' };
use Test::Trap qw/ $basic    basic    :output(systemsafe)          /;
use Test::Trap qw/ $preserve preserve :output(systemsafe-preserve) /;
use Test::Trap qw/ $utf8     utf8     :output(utf8)                /;
use Test::Trap qw/ $both     both     :output(both)                /;
use Test::Trap qw/ $latin2   latin2   :output(latin2)              /;

my @layers = qw(basic preserve utf8 both latin2);

our($trap);
sub trap(&);

# For RT #102271:
# The STDOUT may actually have a utf8 layer, from PERL_UNICODE or PERL5OPT or whatever.
# So, check it:
my $original_utf8 = grep { /utf8/ } PerlIO::get_layers(*STDOUT);

# Test 1: Å‚ (l stroke); no messing with STDOUT
for my $glob (@layers) {
  no strict 'refs';
  local *trap = *$glob;