r49557 - in /branches/upstream/libtest-trap-perl/current: ./ lib/Test/ lib/Test/Trap/ lib/Test/Trap/Builder/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Wed Dec 30 17:15:37 UTC 2009
Author: gregoa
Date: Wed Dec 30 17:15:30 2009
New Revision: 49557
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49557
Log:
[svn-upgrade] Integrating new upstream version, libtest-trap-perl (0.2.1)
Added:
branches/upstream/libtest-trap-perl/current/t/08-fork.PL
branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic.PL
Removed:
branches/upstream/libtest-trap-perl/current/t/08-fork-no-taint.t
branches/upstream/libtest-trap-perl/current/t/08-fork-taint.t
branches/upstream/libtest-trap-perl/current/t/08-fork.pl
branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic-no-taint.t
branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic-taint.t
branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic.pl
Modified:
branches/upstream/libtest-trap-perl/current/Build.PL
branches/upstream/libtest-trap-perl/current/Changes
branches/upstream/libtest-trap-perl/current/MANIFEST
branches/upstream/libtest-trap-perl/current/META.yml
branches/upstream/libtest-trap-perl/current/Makefile.PL
branches/upstream/libtest-trap-perl/current/lib/Test/Trap.pm
branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder.pm
branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/PerlIO.pm
branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/SystemSafe.pm
branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/TempFile.pm
branches/upstream/libtest-trap-perl/current/t/01-basic.t
branches/upstream/libtest-trap-perl/current/t/02-reentrant.t
branches/upstream/libtest-trap-perl/current/t/03-files.pl
branches/upstream/libtest-trap-perl/current/t/04-exit.t
branches/upstream/libtest-trap-perl/current/t/06-layers.t
branches/upstream/libtest-trap-perl/current/t/07-subclass.t
branches/upstream/libtest-trap-perl/current/t/09-array-accessor.t
branches/upstream/libtest-trap-perl/current/t/10-tester.t
branches/upstream/libtest-trap-perl/current/t/12-systemsafe-errors.t
branches/upstream/libtest-trap-perl/current/t/13-regressions.t
Modified: branches/upstream/libtest-trap-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/Build.PL?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/Build.PL (original)
+++ branches/upstream/libtest-trap-perl/current/Build.PL Wed Dec 30 17:15:30 2009
@@ -2,43 +2,7 @@
use warnings;
use Module::Build;
-my $class = Module::Build->subclass( code => <<'TRICK_EMACS' . <<'END_SUBCLASS' );
-TRICK_EMACS
-
-=head1 ACTIONS
-
-=head2 authortest
-
-This runs all the C<xt/author> tests, as well as the ordinary tests,
-after making sure that the build, manifest, and distmeta actions have
-been taken.
-
-=cut
-
-sub ACTION_authortest {
- my ($self) = @_;
-
- $self->depends_on('build');
- $self->depends_on('manifest');
- $self->depends_on('distmeta');
-
- $self->test_files( qw< t xt/author > );
- $self->recursive_test_files(1);
-
- $self->depends_on('test');
-
- return;
-}
-
-sub ACTION_distdir {
- my ($self) = @_;
-
- $self->depends_on('authortest');
-
- return $self->SUPER::ACTION_distdir();
-}
-
-END_SUBCLASS
+my $class = Module::Build->subclass( code => do { local $/; <DATA> } );
my $builder = $class->new
( module_name => 'Test::Trap',
@@ -63,7 +27,83 @@
'version' => 0,
'warnings' => 0,
},
- add_to_cleanup => [ 'Test-Trap-*' ],
+ PL_files =>
+ { 't/08-fork.PL' => 't/08-fork.t',
+ 't/11-systemsafe-basic.PL' => 't/11-systemsafe-basic.t',
+ },
+ add_to_cleanup =>
+ [ 'Test-Trap-*',
+ 't/08-fork.t',
+ 't/11-systemsafe-basic.t',
+ ],
);
$builder->create_build_script();
+
+__DATA__
+
+=head1 ACTIONS
+
+=head2 authortest
+
+This runs all the C<xt/author> tests, as well as the ordinary tests,
+after making sure that the build, manifest, and distmeta actions have
+been taken.
+
+=cut
+
+sub ACTION_authortest {
+ my ($self) = @_;
+
+ $self->depends_on('build');
+ $self->depends_on('manifest');
+ $self->depends_on('distmeta');
+
+ $self->test_files( qw< t xt/author > );
+ $self->recursive_test_files(1);
+
+ $self->depends_on('test');
+
+ return;
+}
+
+sub ACTION_distdir {
+ my ($self) = @_;
+
+ $self->depends_on('authortest');
+
+ return $self->SUPER::ACTION_distdir();
+}
+
+sub ACTION_distmeta {
+ my ($self) = @_;
+
+ require Module::Build::Compat;
+ unless (Module::Build::Compat->VERSION gt 0.31 or eval { Module::Build::Compat->PL_FILES_PATCH }) {
+ die <<'DIE'
+Too old Module::Build::Compat to Build distmeta.
+Upgrade if possible or apply the following hack patch:
+--- Compat.pm 2008-10-04 02:14:02.000000000 +0200
++++ Compat.pm 2008-10-04 02:15:10.000000000 +0200
+@@ -139,7 +139,7 @@
+
+ $MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
+
+- $MM_Args{PL_FILES} = {};
++ $MM_Args{PL_FILES} = $build->PL_files;
+
+ local $Data::Dumper::Terse = 1;
+ my $args = Data::Dumper::Dumper(\%MM_Args);
+@@ -153,6 +153,7 @@
+ }
+ }
+
++sub PL_FILES_PATCH { 1 }
+
+ sub subclass_dir {
+ my ($self, $build) = @_;
+DIE
+ }
+
+ return $self->SUPER::ACTION_distmeta();
+}
Modified: branches/upstream/libtest-trap-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/Changes?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/Changes (original)
+++ branches/upstream/libtest-trap-perl/current/Changes Wed Dec 30 17:15:30 2009
@@ -1,4 +1,18 @@
Revision history for Test-Trap
+
+0.2.1 Tue Dec 29 23:14:45 CET 2009
+ Documentation:
+ - fix a typo, [RT #48941]; thanks go to David Taylor;
+ Tests:
+ - use .PL-files to build the test files t/08-fork.t and
+ t/11-systemsafe-basic.t instead of dispatching through
+ *-taint.t and *-no-taint.t files at runtime;
+ Build:
+ - setup the build of the above test files in Build.PL;
+ - add a ACTION_distmeta override to check for patch to or
+ version of Module::Build::Compat with correct handling of
+ PL_FILES/PL_files;
+ - update the MANIFEST and .SKIP files accordingly.
0.2.0 Tue Sep 30 04:28:30 CEST 2008
Test::Trap::Builder::SystemSafe:
Modified: branches/upstream/libtest-trap-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/MANIFEST?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/MANIFEST (original)
+++ branches/upstream/libtest-trap-perl/current/MANIFEST Wed Dec 30 17:15:30 2009
@@ -20,14 +20,10 @@
t/05-import.t
t/06-layers.t
t/07-subclass.t
-t/08-fork-no-taint.t
-t/08-fork-taint.t
-t/08-fork.pl
+t/08-fork.PL
t/09-array-accessor.t
t/10-tester.t
-t/11-systemsafe-basic-no-taint.t
-t/11-systemsafe-basic-taint.t
-t/11-systemsafe-basic.pl
+t/11-systemsafe-basic.PL
t/12-systemsafe-errors.t
t/13-regressions.t
t/99-coverage.t
Modified: branches/upstream/libtest-trap-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/META.yml?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/META.yml (original)
+++ branches/upstream/libtest-trap-perl/current/META.yml Wed Dec 30 17:15:30 2009
@@ -1,6 +1,6 @@
---
name: Test-Trap
-version: 0.2.0
+version: v0.2.1
author:
- 'Eirik Berg Hanssen <Eirik-Berg.Hanssen at allverden.no>'
abstract: 'Trap exit codes, exceptions, output, etc.'
@@ -19,27 +19,29 @@
base: 0
constant: 0
lib: 0
- perl: 5.6.2
+ perl: v5.6.2
strict: 0
version: 0
warnings: 0
+configure_requires:
+ Module::Build: 0.35
provides:
Test::Trap:
file: lib/Test/Trap.pm
- version: 0.2.0
+ version: v0.2.1
Test::Trap::Builder:
file: lib/Test/Trap/Builder.pm
- version: 0.2.0
+ version: v0.2.1
Test::Trap::Builder::PerlIO:
file: lib/Test/Trap/Builder/PerlIO.pm
- version: 0.2.0
+ version: v0.2.1
Test::Trap::Builder::SystemSafe:
file: lib/Test/Trap/Builder/SystemSafe.pm
- version: 0.2.0
+ version: v0.2.1
Test::Trap::Builder::TempFile:
file: lib/Test/Trap/Builder/TempFile.pm
- version: 0.2.0
-generated_by: Module::Build version 0.280801
+ version: v0.2.1
+generated_by: Module::Build version 0.35
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libtest-trap-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/Makefile.PL?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/Makefile.PL (original)
+++ branches/upstream/libtest-trap-perl/current/Makefile.PL Wed Dec 30 17:15:30 2009
@@ -1,9 +1,12 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
+# Note: this file was auto-generated by Module::Build::Compat version 0.35
require 5.6.2;
use ExtUtils::MakeMaker;
WriteMakefile
(
- 'PL_FILES' => {},
+ 'PL_FILES' => {
+ 't/08-fork.PL' => 't/08-fork.t',
+ 't/11-systemsafe-basic.PL' => 't/11-systemsafe-basic.t'
+ },
'INSTALLDIRS' => 'site',
'NAME' => 'Test::Trap',
'EXE_FILES' => [],
Modified: branches/upstream/libtest-trap-perl/current/lib/Test/Trap.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/lib/Test/Trap.pm?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/lib/Test/Trap.pm (original)
+++ branches/upstream/libtest-trap-perl/current/lib/Test/Trap.pm Wed Dec 30 17:15:30 2009
@@ -1,6 +1,6 @@
package Test::Trap;
-use version; $VERSION = qv('0.2.0');
+use version; $VERSION = qv('0.2.1');
use strict;
use warnings;
@@ -301,7 +301,7 @@
=head1 VERSION
-Version 0.2.0
+Version 0.2.1
=head1 SYNOPSIS
@@ -321,7 +321,7 @@
return values from boxed blocks of test code.
The values collected by the latest trap can then be queried or tested
-through a a special trap object.
+through a special trap object.
=head1 EXPORT
Modified: branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder.pm?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder.pm (original)
+++ branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder.pm Wed Dec 30 17:15:30 2009
@@ -1,6 +1,6 @@
package Test::Trap::Builder;
-use version; $VERSION = qv('0.2.0');
+use version; $VERSION = qv('0.2.1');
use strict;
use warnings;
@@ -366,7 +366,7 @@
=head1 VERSION
-Version 0.2.0
+Version 0.2.1
=head1 SYNOPSIS
Modified: branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/PerlIO.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/PerlIO.pm?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/PerlIO.pm (original)
+++ branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/PerlIO.pm Wed Dec 30 17:15:30 2009
@@ -1,6 +1,6 @@
package Test::Trap::Builder::PerlIO;
-use version; $VERSION = qv('0.2.0');
+use version; $VERSION = qv('0.2.1');
use strict;
use warnings;
@@ -30,7 +30,7 @@
=head1 VERSION
-Version 0.2.0
+Version 0.2.1
=head1 DESCRIPTION
Modified: branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/SystemSafe.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/SystemSafe.pm?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/SystemSafe.pm (original)
+++ branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/SystemSafe.pm Wed Dec 30 17:15:30 2009
@@ -1,6 +1,6 @@
package Test::Trap::Builder::SystemSafe;
-use version; $VERSION = qv('0.2.0');
+use version; $VERSION = qv('0.2.1');
use strict;
use warnings;
@@ -90,7 +90,7 @@
=head1 VERSION
-Version 0.2.0
+Version 0.2.1
=head1 DESCRIPTION
Modified: branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/TempFile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/TempFile.pm?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/TempFile.pm (original)
+++ branches/upstream/libtest-trap-perl/current/lib/Test/Trap/Builder/TempFile.pm Wed Dec 30 17:15:30 2009
@@ -1,6 +1,6 @@
package Test::Trap::Builder::TempFile;
-use version; $VERSION = qv('0.2.0');
+use version; $VERSION = qv('0.2.1');
use strict;
use warnings;
@@ -43,7 +43,7 @@
=head1 VERSION
-Version 0.2.0
+Version 0.2.1
=head1 DESCRIPTION
Modified: branches/upstream/libtest-trap-perl/current/t/01-basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/01-basic.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/01-basic.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/01-basic.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/01-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 2 + 8*9;
use strict;
use warnings;
Modified: branches/upstream/libtest-trap-perl/current/t/02-reentrant.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/02-reentrant.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/02-reentrant.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/02-reentrant.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/02-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 1 + 6*5 + 3;
use strict;
use warnings;
Modified: branches/upstream/libtest-trap-perl/current/t/03-files.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/03-files.pl?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/03-files.pl (original)
+++ branches/upstream/libtest-trap-perl/current/t/03-files.pl Wed Dec 30 17:15:30 2009
@@ -1,5 +1,6 @@
#!perl -T
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More;
use IO::Handle;
use File::Temp qw( tempfile );
Modified: branches/upstream/libtest-trap-perl/current/t/04-exit.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/04-exit.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/04-exit.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/04-exit.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/04-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 6;
use strict;
use warnings;
Modified: branches/upstream/libtest-trap-perl/current/t/06-layers.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/06-layers.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/06-layers.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/06-layers.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/06-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 4*15 + 4*5 + 3*6 + 5*13; # non-default standard layers + output backend + internal exceptions + exits
use IO::Handle;
use File::Temp qw( tempfile );
Modified: branches/upstream/libtest-trap-perl/current/t/07-subclass.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/07-subclass.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/07-subclass.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/07-subclass.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/07-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 8 + 5*18;
use strict;
use warnings;
Added: branches/upstream/libtest-trap-perl/current/t/08-fork.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/08-fork.PL?rev=49557&op=file
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/08-fork.PL (added)
+++ branches/upstream/libtest-trap-perl/current/t/08-fork.PL Wed Dec 30 17:15:30 2009
@@ -1,0 +1,153 @@
+#!perl
+# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/08-*.t" -*-
+use strict;
+use warnings;
+
+use Config;
+
+my $code = '';
+my $flags = '';
+
+# Thank you, http://search.cpan.org/src/DAGOLDEN/Class-InsideOut-1.02/t/05_forking.t
+
+# If Win32, fork() is done with threads, so we need various things
+if ( $^O =~ /^(?:MSWin32|NetWare|WinCE)\z/ ) {
+
+ $code .= <<'COVERAGE';
+# don't run this at all under Devel::Cover
+if ( $ENV{HARNESS_PERL_SWITCHES} &&
+ $ENV{HARNESS_PERL_SWITCHES} =~ /Devel::Cover/ ) {
+ plan skip_all => 'Devel::Cover not compatible with Win32 pseudo-fork';
+}
+COVERAGE
+
+ # skip if threads not available for some reasons
+ if ( ! $Config{useithreads} ) {
+ $code .= <<NOTHREADS;
+plan skip_all => "Win32 fork() support requires threads";
+NOTHREADS
+ }
+
+ # skip if perl < 5.8
+ if ( $] < 5.008 ) {
+ $code .= <<NOTHREADS;
+plan skip_all => "Win32 fork() support requires perl 5.8";
+NOTHREADS
+ }
+}
+elsif (!$Config{d_fork}) {
+ $code .= <<NOFORK;
+plan skip_all => 'Fork tests are irrelevant without fork()';
+NOFORK
+}
+else {
+ $flags = ' -T';
+ $code .= <<DIAG
+BEGIN {
+ diag('Real fork; taint checks enabled');
+}
+DIAG
+}
+
+(my $file = __FILE__) =~ s/\.PL$/.t/;
+open my $fh, '>', $file or die "Cannot open '$file': '$!'";
+
+print $fh "#!perl$flags\n", <<'CODA', $code;
+# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/08-*.t" -*-;
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
+use Test::More tests => 15;
+use strict;
+use warnings;
+
+CODA
+
+print $fh <DATA>;
+
+exit 0;
+
+__DATA__
+
+my $flag;
+BEGIN {
+ *CORE::GLOBAL::exit = sub(;$) {
+ if ($flag) {
+ pass("The final test: The outer CORE::GLOBAL::exit is eventually called");
+ }
+ else {
+ fail("The outer CORE::GLOBAL::exit is called too soon!");
+ }
+ CORE::exit(@_ ? shift : 0);
+ };
+}
+
+BEGIN {
+ use_ok( 'Test::Trap' );
+}
+
+# check that the setup works -- the exit is still trapped:
+trap { exit };
+is( $trap->exit, 0, "Trapped the first exit");
+
+# check that the exit from the forked-off process reverts to the inner
+# CORE::GLOBAL::exit, not the outer
+trap {
+ *CORE::GLOBAL::exit = sub(;$) {
+ pass("The inner CORE::GLOBAL::exit is called from the child");
+ CORE::exit(@_ ? shift : 0);
+ };
+ trap {
+ fork;
+ exit;
+ };
+ wait; # let the child finish first
+ # Increment the counter correctly ...
+ my $Test = Test::More->builder;
+ $Test->current_test( $Test->current_test + 1 );
+ is( $trap->exit, 0, "Trapped the inner exit");
+};
+like( $trap->stderr, qr/^Subroutine (?:CORE::GLOBAL::)?exit \Qredefined at ${\__FILE__} line/, 'Override warning' );
+
+trap {
+ trap{
+ trap {
+ fork;
+ exit;
+ };
+ wait;
+ is( $trap->exit, 0, "Trapped the inner exit" );
+ }
+};
+is( $trap->leaveby, 'return', 'Should return just once, okay?' );
+
+# Output from forked-off processes?
+my $me;
+trap {
+ $me = fork ? 'parent' : 'child';
+ print "\u$me print\n";
+ warn "\u$me warning\n";
+ wait, exit $$ if $me eq 'parent';
+};
+CORE::exit(0) if $me eq 'child';
+is( $trap->exit, $$, "Trapped the parent exit" );
+like( $trap->stdout, qr/^(Parent print\nChild print\n|Child print\nParent print\n)/, 'STDOUT from both processes!' );
+like( $trap->stderr, qr/^(Parent warning\nChild warning\n|Child warning\nParent warning\n)/, 'STDERR from both processes!' );
+is_deeply( $trap->warn, ["Parent warning\n"], 'Warnings from the parent only' );
+
+# STDERR from forked-off processes, with a closed STDIN & STDOUT?
+trap {
+ close STDOUT;
+ trap {
+ my $me = fork ? 'parent' : 'child';
+ print "\u$me print\n";
+ warn "\u$me warning\n";
+ wait, exit $$ if $me eq 'parent';
+ CORE::exit(0);
+ };
+ is( $trap->exit, $$, "Trapped the parent exit" );
+ is( $trap->stdout, '', 'STDOUT from both processes is nil -- the handle is closed!' );
+ like( $trap->stderr, qr/\A(?=.*^Parent warning$)(?=.*^Child warning$)/ms, 'STDERR from both processes!' );
+};
+
+$flag++; # the exit test will now pass -- in the forked-off processes it will fail!
+exit;
Modified: branches/upstream/libtest-trap-perl/current/t/09-array-accessor.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/09-array-accessor.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/09-array-accessor.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/09-array-accessor.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/09-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 6;
use strict;
use warnings;
Modified: branches/upstream/libtest-trap-perl/current/t/10-tester.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/10-tester.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/10-tester.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/10-tester.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/10-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::Tester;
use Test::More tests => 2 + 3 + 7*15 + 5*3;
use strict;
Added: branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic.PL?rev=49557&op=file
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic.PL (added)
+++ branches/upstream/libtest-trap-perl/current/t/11-systemsafe-basic.PL Wed Dec 30 17:15:30 2009
@@ -1,0 +1,214 @@
+#!perl
+# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/11-*.t" -*-
+use strict;
+use warnings;
+
+use Config;
+
+my $code = '';
+my $flags = '';
+
+# Thank you, http://search.cpan.org/src/DAGOLDEN/Class-InsideOut-1.02/t/05_forking.t
+
+# If Win32, fork() is done with threads, so we need various things
+if ( $^O =~ /^(?:MSWin32|NetWare|WinCE)\z/ ) {
+
+ $code .= <<'COVERAGE';
+# don't run this at all under Devel::Cover
+if ( $ENV{HARNESS_PERL_SWITCHES} &&
+ $ENV{HARNESS_PERL_SWITCHES} =~ /Devel::Cover/ ) {
+ plan skip_all => 'Devel::Cover not compatible with Win32 pseudo-fork';
+}
+COVERAGE
+
+ # skip if threads not available for some reasons
+ if ( ! $Config{useithreads} ) {
+ $code .= <<NOTHREADS;
+plan skip_all => "Win32 fork() support requires threads";
+NOTHREADS
+ }
+
+ # skip if perl < 5.8
+ if ( $] < 5.008 ) {
+ $code .= <<NOTHREADS;
+plan skip_all => "Win32 fork() support requires perl 5.8";
+NOTHREADS
+ }
+}
+elsif (!$Config{d_fork}) {
+ $code .= <<NOFORK;
+plan skip_all => 'Fork tests are irrelevant without fork()';
+NOFORK
+}
+else {
+ $flags = ' -T';
+ $code .= <<DIAG
+BEGIN {
+ diag('Real fork; taint checks enabled');
+}
+DIAG
+}
+
+(my $file = __FILE__) =~ s/\.PL$/.t/;
+open my $fh, '>', $file or die "Cannot open '$file': '$!'";
+
+print $fh "#!perl$flags\n", <<'CODA', $code;
+# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/11-*.t" -*-;
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
+use Test::More;
+use strict;
+use warnings;
+
+CODA
+
+print $fh <DATA>;
+
+exit 0;
+
+__DATA__
+
+use File::Temp qw( tempfile );
+
+use Test::Trap::Builder::SystemSafe;
+
+use Test::Trap qw( trap $T :flow:stderr(systemsafe):stdout(systemsafe):warn );
+
+BEGIN {
+ # silence some warnings that make coverage reports hard to get at
+ if ($Storable::VERSION) {
+ eval {
+ eval { no warnings; Storable::retrieve('.') }; # silly, but hopefully safe ...
+ my $_r = \&Storable::_retrieve;
+ no warnings 'redefine';
+ *Storable::_retrieve = sub {
+ no warnings;
+ local $SIG{__WARN__} = sub {};
+ $_r->(@_);
+ };
+ };
+ }
+ if ($Devel::Cover::DB::Structure::VERSION) {
+ eval {
+ my $d = \&Devel::Cover::DB::Structure::digest;
+ no warnings 'redefine';
+ *Devel::Cover::DB::Structure::digest = sub {
+ no warnings;
+ local $SIG{__WARN__} = sub {};
+ $d->(@_);
+ };
+ };
+ }
+}
+
+# Protect against tainted PATH &c ...
+$ENV{PATH} = '';
+$ENV{ENV} = '';
+$ENV{BASH_ENV} = '';
+
+my ($PERL) = $^X =~ /^([\w.\/:\\~-]+)$/;
+if ($PERL) {
+ plan tests => 3 + 6*6 + 4;
+}
+else {
+ plan skip_all => "Odd perl path: $^X";
+}
+
+
+my $desc = "fdopen()ed file handle";
+SKIP: {
+ skip 'These tests are irrelevant on old perls', 3 if $] < 5.008;
+ open my $fh, '>&=STDOUT' or die "Cannot fdopen STDOUT: '$!'";
+ exit diag "Got fileno " . fileno($fh) unless fileno($fh)==1;
+
+ # Basic error situation: STDOUT cannot be reopened on fd-1:
+ eval { trap { system $PERL, '-e', 'binmode STDOUT; binmode STDERR; warn qq(0123456789Warning\n); print qq(Printing\n)'; exit 1 } };
+ like( $@, qr/^\QCannot get the desired descriptor, '1' (could it be that it is fdopened and so still open?)/, "$desc: exception string" );
+ is( fileno STDOUT, undef, "$desc: STDOUT should be left closed by now")
+ or exit diag "Got STDOUT with fd " . fileno(STDOUT);
+ is( fileno STDERR, 2, "$desc: STDERR fileno should be unchanged");
+
+ unless (fileno(STDOUT) or open STDOUT, '>&=' . fileno $fh) {
+ exit diag "Cannot fdopen fno ".fileno($fh).": '$!'";
+ }
+ if (fileno $fh and !close $fh) {
+ exit diag "Cannot close: '$!'";
+ }
+}
+
+$desc = "simple fork test";
+trap {
+ fork ? wait : do { warn "0123456789Warning\n"; print "Printing\n" };
+ exit 1;
+};
+is( $T->exit, 1, "$desc: exit(1)" );
+is( $T->stdout, "Printing\n", "$desc: system() STDOUT" );
+is( $T->stderr, "0123456789Warning\n", "$desc: system() STDERR" );
+is( join("\n", @{$T->warn}), '', "$desc: No warnings" );
+
+# Have the file handles been re-opened on the right descriptors?
+is( fileno STDOUT, 1, "$desc: STDOUT fileno should be unchanged");
+is( fileno STDERR, 2, "$desc: STDERR fileno should be unchanged");
+
+# Basic messing-up -- protect the handles with an outer trap:
+trap {
+ for (1..5) {
+ my $desc = "Take $_";
+ my $OUTFNO = 1;
+ my $EXPECT = "Printing\n";
+ if ($_ > 2) {
+ close STDIN;
+ $desc .= ' - STDIN closed';
+ }
+ if ($_ > 3) {
+ close STDOUT;
+ undef $OUTFNO;
+ $EXPECT = '';
+ $desc .= ' - STDOUT closed';
+ }
+
+ # Output from forked-off processes?
+ trap {
+ my @args = ($PERL, '-e', 'binmode STDOUT; binmode STDERR; warn qq(0123456789Warning\n); print qq(Printing\n)');
+ system @args and die "system @args failed with $?";
+ exit 1;
+ };
+ is( $T->exit, 1, "$desc: exit(1)" )
+ or $T->diag_all;
+ is( $T->stdout, $EXPECT, "$desc: system() STDOUT" );
+ is( $T->stderr, "0123456789Warning\n", "$desc: system() STDERR" );
+ is( join("\n", @{$T->warn}), '', "$desc: No warnings" );
+
+ # Have the file handles been re-opened on the right descriptors?
+ is( fileno STDOUT, $OUTFNO, "$desc: STDOUT fileno should be unchanged");
+ is( fileno STDERR, 2, "$desc: STDERR fileno should be unchanged");
+ }
+};
+
+SKIP: {
+ use Config;
+ unless ($Config{d_fork}) {
+ skip 'Need a real fork()', 4;
+ }
+ # For coverage: Output from forked-off processes?
+ my $me;
+ trap {
+ trap {
+ $me = fork ? 'parent' : 'child';
+ print "\u$me print\n";
+ warn "\u$me warning\n";
+ trap { 1 };
+ wait, exit $$ if $me eq 'parent';
+ };
+ # On windows, in the child pseudo-process, this dies on leaving
+ # the trap (fd 2 is not availible, because it is open in another
+ # thread). I don't think anything can be done about it.
+ CORE::exit(0) if $me eq 'child';
+ is( $T->exit, $$, "Trapped the parent exit" );
+ like( $T->stdout, qr/^(Parent print\nChild print\n|Child print\nParent print\n)/, 'STDOUT from both processes!' );
+ like( $T->stderr, qr/^(Parent warning\nChild warning\n|Child warning\nParent warning\n)/, 'STDERR from both processes!' );
+ is_deeply( $T->warn, ["Parent warning\n"], 'Warnings from the parent only' );
+ };
+}
+
+exit;
Modified: branches/upstream/libtest-trap-perl/current/t/12-systemsafe-errors.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/12-systemsafe-errors.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/12-systemsafe-errors.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/12-systemsafe-errors.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/12-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 10;
use strict;
use warnings;
Modified: branches/upstream/libtest-trap-perl/current/t/13-regressions.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-trap-perl/current/t/13-regressions.t?rev=49557&op=diff
==============================================================================
--- branches/upstream/libtest-trap-perl/current/t/13-regressions.t (original)
+++ branches/upstream/libtest-trap-perl/current/t/13-regressions.t Wed Dec 30 17:15:30 2009
@@ -1,5 +1,7 @@
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/13-*.t" -*-
+
+BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 5;
use strict;
use warnings;
More information about the Pkg-perl-cvs-commits
mailing list