Test-Trap
view release on metacpan or search on metacpan
t/03-files.pl view on Meta::CPAN
454647484950515253545556575859606162636465
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!"
;
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
121314151617181920212223242526272829303132use
Test::Refcount;
use
strict;
use
warnings;
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
212223242526272829303132333435363738394041my
@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
212223242526272829303132333435363738394041my
@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
;
( run in 0.245 second using v1.01-cache-2.11-cpan-1dc43b0fbd2 )