4 if ( $ENV{PERL_CORE} ) {
6 @INC = ( '../lib', 'lib' );
13 # test T::H::_open_spool and _close_spool - these are good examples
14 # of the 'Fragile Test' pattern - messing with I/O primitives breaks
23 # setup replacements for core open and close - breaking these makes everything very fragile
25 $useOrigOpen = $useOrigClose = 1;
27 # taken from http://www.perl.com/pub/a/2002/06/11/threads.html?page=2
29 *CORE::GLOBAL::open = \&my_open;
33 if ( defined( $_[0] ) ) {
35 my $handle = Symbol::qualify( $_[0], (caller)[0] );
38 return CORE::open($handle);
41 return CORE::open( $handle, $_[1] );
44 die "Can't open with more than two args";
53 *CORE::GLOBAL::close = sub (*) {
54 if ($useOrigClose) { return CORE::close(shift) }
67 # coverage tests for the basically untested T::H::_open_spool
69 my @spool = ( $ENV{PERL_CORE} ? ('spool') : ( 't', 'spool' ) );
70 $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(@spool);
72 # now given that we're going to be writing stuff to the file system, make sure we have
78 $useOrigOpen = $useOrigClose = 1;
80 # remove the tree if we made it this far
81 rmtree( $ENV{PERL_TEST_HARNESS_DUMP_TAP} )
82 if $ENV{PERL_TEST_HARNESS_DUMP_TAP};
88 local $SIG{__DIE__} = sub { push @die, @_ };
93 TAP::Harness->_open_spool(
94 File::Spec->catfile(qw (source_tests harness )) );
96 # restore universal sanity
100 is @die, 1, 'open failed, die as expected';
102 my $spoolDir = quotemeta(
103 File::Spec->catfile( @spool, qw( source_tests harness ) ) );
105 like pop @die, qr/ Can't write $spoolDir \( /, '...with expected message';
107 # now make close fail
111 my $spoolHandle = gensym;
113 my $tap = <<'END_TAP';
115 ok 1 - input file opened
119 my $parser = TAP::Parser->new(
120 { spool => $spoolHandle,
121 stream => TAP::Parser::Iterator->new( [ split /\n/ => $tap ] )
128 local $SIG{__DIE__} = sub { push @die, @_ };
130 # use the broken CORE::close
133 TAP::Harness->_close_spool($parser);
138 unless ( is @die, 1, 'close failed, die as expected' ) {
139 diag " >>> $_ <<<\n" for @die;
142 like pop @die, qr/ Error closing TAP spool file[(] /,
143 '...with expected message';