diff options
155 files changed, 1597 insertions, 800 deletions
@@ -151,6 +151,7 @@ ext/Compress-Raw-Bzip2/t/000prereq.t ext/Compress-Raw-Bzip2/t/01bzip2.t ext/Compress-Raw-Bzip2/t/09limitoutput.t ext/Compress-Raw-Bzip2/t/99pod.t +ext/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm ext/Compress-Raw-Bzip2/typemap ext/Compress-Raw-Zlib/Changes Compress::Raw::Zlib ext/Compress-Raw-Zlib/config.in Compress::Raw::Zlib @@ -168,6 +169,7 @@ ext/Compress-Raw-Zlib/t/02zlib.t Compress::Raw::Zlib ext/Compress-Raw-Zlib/t/07bufsize.t Compress::Raw::Zlib ext/Compress-Raw-Zlib/t/09limitoutput.t Compress::Raw::Zlib ext/Compress-Raw-Zlib/t/18lvalue.t Compress::Raw::Zlib +ext/Compress-Raw-Zlib/t/compress/CompTestUtils.pm ext/Compress-Raw-Zlib/typemap Compress::Raw::Zlib ext/Compress-Raw-Zlib/zlib-src/adler32.c Compress::Raw::Zlib ext/Compress-Raw-Zlib/zlib-src/compress.c Compress::Raw::Zlib @@ -223,6 +225,23 @@ ext/DB_File/typemap Berkeley DB extension interface types ext/DB_File/version.c Berkeley DB extension interface version check ext/Devel-DProf/Changes Perl code profiler changelog ext/Devel-DProf/DProf.pm Perl code profiler +ext/Devel-DProf/dprof/test1_t Perl code profiler tests +ext/Devel-DProf/dprof/test1_v Perl code profiler tests +ext/Devel-DProf/dprof/test2_t Perl code profiler tests +ext/Devel-DProf/dprof/test2_v Perl code profiler tests +ext/Devel-DProf/dprof/test3_t Perl code profiler tests +ext/Devel-DProf/dprof/test3_v Perl code profiler tests +ext/Devel-DProf/dprof/test4_t Perl code profiler tests +ext/Devel-DProf/dprof/test4_v Perl code profiler tests +ext/Devel-DProf/dprof/test5_t Perl code profiler tests +ext/Devel-DProf/dprof/test5_v Perl code profiler tests +ext/Devel-DProf/dprof/test6_t Perl code profiler tests +ext/Devel-DProf/dprof/test6_v Perl code profiler tests +ext/Devel-DProf/dprof/test7_t Perl code profiler tests +ext/Devel-DProf/dprof/test7_v Perl code profiler tests +ext/Devel-DProf/dprof/test8_t Perl code profiler tests +ext/Devel-DProf/dprof/test8_v Perl code profiler tests +ext/Devel-DProf/dprof/V.pm Perl code profiler tests ext/Devel-DProf/DProf.xs Perl code profiler ext/Devel-DProf/Makefile.PL Perl code profiler makefile writer ext/Devel-DProf/t/DProf.t Perl code profiler @@ -565,7 +584,6 @@ ext/Encode/t/mime-header.t test script ext/Encode/t/mime-name.t test script ext/Encode/t/Mod_EUCJP.pm module that t/enc_module.enc uses ext/Encode/t/perlio.t test script -ext/Encode/t/piconv.t test script ext/Encode/t/rt.pl test script ext/Encode/t/unibench.pl benchmark script ext/Encode/t/Unicode.t test script @@ -702,6 +720,7 @@ ext/File-Glob/TODO File::Glob extension todo list ext/File-Glob/t/taint.t See if File::Glob works ext/Filter-Util-Call/Call.pm Filter::Util::Call extension module ext/Filter-Util-Call/Call.xs Filter::Util::Call extension external subroutines +ext/Filter-Util-Call/filter-util.pl See if Filter::Util::Call works ext/Filter-Util-Call/t/call.t See if Filter::Util::Call works ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines @@ -855,6 +874,20 @@ ext/IO-Compress/t/110encode-gzip.t IO::Compress ext/IO-Compress/t/110encode-rawdeflate.t IO::Compress ext/IO-Compress/t/110encode-zip.t IO::Compress ext/IO-Compress/t/999pod.t IO::Compress +ext/IO-Compress/t/compress/any.pl Compress::Zlib +ext/IO-Compress/t/compress/anyunc.pl Compress::Zlib +ext/IO-Compress/t/compress/CompTestUtils.pm Compress::Zlib +ext/IO-Compress/t/compress/destroy.pl Compress::Zlib +ext/IO-Compress/t/compress/encode.pl Compress::Zlib +ext/IO-Compress/t/compress/generic.pl Compress::Zlib +ext/IO-Compress/t/compress/merge.pl Compress::Zlib +ext/IO-Compress/t/compress/multi.pl Compress::Zlib +ext/IO-Compress/t/compress/newtied.pl Compress::Zlib +ext/IO-Compress/t/compress/oneshot.pl Compress::Zlib +ext/IO-Compress/t/compress/prime.pl Compress::Zlib +ext/IO-Compress/t/compress/tied.pl Compress::Zlib +ext/IO-Compress/t/compress/truncate.pl Compress::Zlib +ext/IO-Compress/t/compress/zlib-generic.pl Compress::Zlib ext/IO-Compress/t/cz-01version.t IO::Compress ext/IO-Compress/t/cz-05examples.t IO::Compress ext/IO-Compress/t/cz-06gzsetp.t IO::Compress @@ -3990,20 +4023,6 @@ t/lib/Cname.pm Test charnames in regexes (op/pat.t) t/lib/common.pl Helper for lib/{warnings,feature}.t t/lib/commonsense.t See if configuration meets basic needs t/lib/compmod.pl Helper for 1_compile.t -t/lib/compress/any.pl Compress::Zlib -t/lib/compress/anyunc.pl Compress::Zlib -t/lib/compress/CompTestUtils.pm Compress::Zlib -t/lib/compress/destroy.pl Compress::Zlib -t/lib/compress/encode.pl Compress::Zlib -t/lib/compress/generic.pl Compress::Zlib -t/lib/compress/merge.pl Compress::Zlib -t/lib/compress/multi.pl Compress::Zlib -t/lib/compress/newtied.pl Compress::Zlib -t/lib/compress/oneshot.pl Compress::Zlib -t/lib/compress/prime.pl Compress::Zlib -t/lib/compress/tied.pl Compress::Zlib -t/lib/compress/truncate.pl Compress::Zlib -t/lib/compress/zlib-generic.pl Compress::Zlib t/lib/contains_bad_pod.xr Pod-Parser test file t/lib/contains_pod.xr Pod-Parser test file t/lib/croak.t Test calls to Perl_croak() in the C source. @@ -4013,23 +4032,6 @@ t/lib/deprecate/Optionally.pm Optionally deprecated module to test deprecate.pm t/lib/deprecate.t Test deprecate.pm t/lib/Devel/switchd.pm Module for t/run/switchd.t t/lib/Dev/Null.pm Test::More test module -t/lib/dprof/test1_t Perl code profiler tests -t/lib/dprof/test1_v Perl code profiler tests -t/lib/dprof/test2_t Perl code profiler tests -t/lib/dprof/test2_v Perl code profiler tests -t/lib/dprof/test3_t Perl code profiler tests -t/lib/dprof/test3_v Perl code profiler tests -t/lib/dprof/test4_t Perl code profiler tests -t/lib/dprof/test4_v Perl code profiler tests -t/lib/dprof/test5_t Perl code profiler tests -t/lib/dprof/test5_v Perl code profiler tests -t/lib/dprof/test6_t Perl code profiler tests -t/lib/dprof/test6_v Perl code profiler tests -t/lib/dprof/test7_t Perl code profiler tests -t/lib/dprof/test7_v Perl code profiler tests -t/lib/dprof/test8_t Perl code profiler tests -t/lib/dprof/test8_v Perl code profiler tests -t/lib/dprof/V.pm Perl code profiler tests t/lib/feature/bundle Tests for feature bundles t/lib/feature/implicit Tests for implicit loading of feature.pm t/lib/feature/nonesuch Tests for enabling/disabling nonexistent feature @@ -4039,7 +4041,6 @@ t/lib/Filter/Simple/ExportTest.pm Helper file for Filter::Simple tests t/lib/Filter/Simple/FilterOnlyTest.pm Helper file for Filter::Simple tests t/lib/Filter/Simple/FilterTest.pm Helper file for Filter::Simple tests t/lib/Filter/Simple/ImportTest.pm Helper file for Filter::Simple tests -t/lib/filter-util.pl See if Filter::Util::Call works t/lib/h2ph.h Test header file for h2ph t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison t/lib/locale/latin1 Part of locale.t in Latin 1 diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 62f24d0c64..72b72d32a3 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -349,7 +349,6 @@ package Maintainers; # NB: we use the CompTestUtils.pm # from IO-Compress instead qw( bzip2-src/bzip2-cpp.patch - t/compress/CompTestUtils.pm ) ], 'CPAN' => 1, @@ -367,12 +366,9 @@ package Maintainers; 'EXCLUDED' => [ qr{^t/Test/}, qw( t/000prereq.t t/99pod.t - t/compress/CompTestUtils.pm ) ], 'MAP' => { '' => 'ext/Compress-Raw-Zlib/', - 't/compress/CompTestUtils.pm' => - 't/lib/compress/CompTestUtils.pm', }, 'CPAN' => 1, 'UPSTREAM' => undef, @@ -581,6 +577,7 @@ package Maintainers; 'MAINTAINER' => 'dankogai', 'DISTRIBUTION' => 'DANKOGAI/Encode-2.35.tar.gz', 'FILES' => q[ext/Encode], + 'EXCLUDED' => [ qw{t/piconv.t} ], # FIXME 'CPAN' => 1, 'UPSTREAM' => undef, }, @@ -908,8 +905,7 @@ package Maintainers; 'EXCLUDED' => [ qr{t/Test/}, qw{t/cz-03zlib-v1.t}, ], - 'MAP' => { 't/compress' => 't/lib/compress', - '' => 'ext/IO-Compress/', + 'MAP' => { '' => 'ext/IO-Compress/', }, 'CPAN' => 1, 'UPSTREAM' => undef, diff --git a/ext/B/t/lint.t b/ext/B/t/lint.t index 851076401b..efe4ff7006 100644 --- a/ext/B/t/lint.t +++ b/ext/B/t/lint.t @@ -143,7 +143,7 @@ RESULT # Check for Module::Plugin support my $res = runperl( - switches => [ '-I../ext/B/t/pluglib', '-MO=Lint,none' ], + switches => [ '-It/pluglib', '-MO=Lint,none' ], prog => 1, stderr => 1, ); diff --git a/ext/B/t/pragma.t b/ext/B/t/pragma.t index af86b05345..2278cc1782 100644 --- a/ext/B/t/pragma.t +++ b/ext/B/t/pragma.t @@ -6,7 +6,8 @@ BEGIN { ## no critic strict @INC = qw(../lib . lib); } else { - unshift @INC, 't'; + unshift @INC, '../../t/lib'; # FIXME when PERL_CORE works again + # unshift @INC, 't'; } require Config; if ( ( $Config::Config{'extensions'} !~ /\bB\b/ ) ) { diff --git a/t/lib/compress/CompTestUtils.pm b/ext/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm index 22b6d5646c..22b6d5646c 100644 --- a/t/lib/compress/CompTestUtils.pm +++ b/ext/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm diff --git a/ext/Compress-Raw-Zlib/t/compress/CompTestUtils.pm b/ext/Compress-Raw-Zlib/t/compress/CompTestUtils.pm new file mode 100644 index 0000000000..22b6d5646c --- /dev/null +++ b/ext/Compress-Raw-Zlib/t/compress/CompTestUtils.pm @@ -0,0 +1,669 @@ +package CompTestUtils; + +package main ; + +use strict ; +use warnings; +use bytes; + +#use lib qw(t t/compress); + +use Carp ; +#use Test::More ; + + + +sub title +{ + #diag "" ; + ok 1, $_[0] ; + #diag "" ; +} + +sub like_eval +{ + like $@, @_ ; +} + +{ + package LexFile ; + + our ($index); + $index = '00000'; + + sub new + { + my $self = shift ; + foreach (@_) + { + # autogenerate the name unless if none supplied + $_ = "tst" . $index ++ . ".tmp" + unless defined $_; + } + chmod 0777, @_; + for (@_) { 1 while unlink $_ } ; + bless [ @_ ], $self ; + } + + sub DESTROY + { + my $self = shift ; + chmod 0777, @{ $self } ; + for (@$self) { 1 while unlink $_ } ; + } + +} + +{ + package LexDir ; + + use File::Path; + sub new + { + my $self = shift ; + foreach (@_) { rmtree $_ } + bless [ @_ ], $self ; + } + + sub DESTROY + { + my $self = shift ; + foreach (@$self) { rmtree $_ } + } +} +sub readFile +{ + my $f = shift ; + + my @strings ; + + if (IO::Compress::Base::Common::isaFilehandle($f)) + { + my $pos = tell($f); + seek($f, 0,0); + @strings = <$f> ; + seek($f, 0, $pos); + } + else + { + open (F, "<$f") + or croak "Cannot open $f: $!\n" ; + binmode F; + @strings = <F> ; + close F ; + } + + return @strings if wantarray ; + return join "", @strings ; +} + +sub touch +{ + foreach (@_) { writeFile($_, '') } +} + +sub writeFile +{ + my($filename, @strings) = @_ ; + 1 while unlink $filename ; + open (F, ">$filename") + or croak "Cannot open $filename: $!\n" ; + binmode F; + foreach (@strings) { + no warnings ; + print F $_ ; + } + close F ; +} + +sub GZreadFile +{ + my ($filename) = shift ; + + my ($uncomp) = "" ; + my $line = "" ; + my $fil = gzopen($filename, "rb") + or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ; + + $uncomp .= $line + while $fil->gzread($line) > 0; + + $fil->gzclose ; + return $uncomp ; +} + +sub hexDump +{ + my $d = shift ; + + if (IO::Compress::Base::Common::isaFilehandle($d)) + { + $d = readFile($d); + } + elsif (IO::Compress::Base::Common::isaFilename($d)) + { + $d = readFile($d); + } + else + { + $d = $$d ; + } + + my $offset = 0 ; + + $d = '' unless defined $d ; + #while (read(STDIN, $data, 16)) { + while (my $data = substr($d, 0, 16)) { + substr($d, 0, 16) = '' ; + printf "# %8.8lx ", $offset; + $offset += 16; + + my @array = unpack('C*', $data); + foreach (@array) { + printf('%2.2x ', $_); + } + print " " x (16 - @array) + if @array < 16 ; + $data =~ tr/\0-\37\177-\377/./; + print " $data\n"; + } + +} + +sub readHeaderInfo +{ + my $name = shift ; + my %opts = @_ ; + + my $string = <<EOM; +some text +EOM + + ok my $x = new IO::Compress::Gzip $name, %opts + or diag "GzipError is $IO::Compress::Gzip::GzipError" ; + ok $x->write($string) ; + ok $x->close ; + + #is GZreadFile($name), $string ; + + ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0 + or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; + ok my $hdr = $gunz->getHeaderInfo(); + my $uncomp ; + ok $gunz->read($uncomp) ; + ok $uncomp eq $string; + ok $gunz->close ; + + return $hdr ; +} + +sub cmpFile +{ + my ($filename, $uue) = @_ ; + return readFile($filename) eq unpack("u", $uue) ; +} + +sub isRawFormat +{ + my $class = shift; + my %raw = map { $_ => 1 } qw( RawDeflate ); + + return defined $raw{$class}; +} + +sub uncompressBuffer +{ + my $compWith = shift ; + my $buffer = shift ; + + my %mapping = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gunzip', + 'IO::Compress::Gzip::gzip' => 'IO::Uncompress::Gunzip', + 'IO::Compress::Deflate' => 'IO::Uncompress::Inflate', + 'IO::Compress::Deflate::deflate' => 'IO::Uncompress::Inflate', + 'IO::Compress::RawDeflate' => 'IO::Uncompress::RawInflate', + 'IO::Compress::RawDeflate::rawdeflate' => 'IO::Uncompress::RawInflate', + 'IO::Compress::Bzip2' => 'IO::Uncompress::Bunzip2', + 'IO::Compress::Bzip2::bzip2' => 'IO::Uncompress::Bunzip2', + 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', + 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip', + 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf' , + 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf', + 'IO::Compress::PPMd' => 'IO::Uncompress::UnPPMd' , + 'IO::Compress::PPMd::ppmd' => 'IO::Uncompress::UnPPMd', + 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', + 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp', + ); + + my $out ; + my $obj = $mapping{$compWith}->new( \$buffer, -Append => 1); + 1 while $obj->read($out) > 0 ; + return $out ; + +} + +my %ErrorMap = ( 'IO::Compress::Gzip' => \$IO::Compress::Gzip::GzipError, + 'IO::Compress::Gzip::gzip' => \$IO::Compress::Gzip::GzipError, + 'IO::Uncompress::Gunzip' => \$IO::Uncompress::Gunzip::GunzipError, + 'IO::Uncompress::Gunzip::gunzip' => \$IO::Uncompress::Gunzip::GunzipError, + 'IO::Uncompress::Inflate' => \$IO::Uncompress::Inflate::InflateError, + 'IO::Uncompress::Inflate::inflate' => \$IO::Uncompress::Inflate::InflateError, + 'IO::Compress::Deflate' => \$IO::Compress::Deflate::DeflateError, + 'IO::Compress::Deflate::deflate' => \$IO::Compress::Deflate::DeflateError, + 'IO::Uncompress::RawInflate' => \$IO::Uncompress::RawInflate::RawInflateError, + 'IO::Uncompress::RawInflate::rawinflate' => \$IO::Uncompress::RawInflate::RawInflateError, + 'IO::Uncompress::AnyInflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, + 'IO::Uncompress::AnyInflate::anyinflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, + 'IO::Uncompress::AnyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, + 'IO::Uncompress::AnyUncompress::anyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, + 'IO::Compress::RawDeflate' => \$IO::Compress::RawDeflate::RawDeflateError, + 'IO::Compress::RawDeflate::rawdeflate' => \$IO::Compress::RawDeflate::RawDeflateError, + 'IO::Compress::Bzip2' => \$IO::Compress::Bzip2::Bzip2Error, + 'IO::Compress::Bzip2::bzip2' => \$IO::Compress::Bzip2::Bzip2Error, + 'IO::Uncompress::Bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, + 'IO::Uncompress::Bunzip2::bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, + 'IO::Compress::Zip' => \$IO::Compress::Zip::ZipError, + 'IO::Compress::Zip::zip' => \$IO::Compress::Zip::ZipError, + 'IO::Uncompress::Unzip' => \$IO::Uncompress::Unzip::UnzipError, + 'IO::Uncompress::Unzip::unzip' => \$IO::Uncompress::Unzip::UnzipError, + 'IO::Compress::Lzop' => \$IO::Compress::Lzop::LzopError, + 'IO::Compress::Lzop::lzop' => \$IO::Compress::Lzop::LzopError, + 'IO::Uncompress::UnLzop' => \$IO::Uncompress::UnLzop::UnLzopError, + 'IO::Uncompress::UnLzop::unlzop' => \$IO::Uncompress::UnLzop::UnLzopError, + 'IO::Compress::Lzf' => \$IO::Compress::Lzf::LzfError, + 'IO::Compress::Lzf::lzf' => \$IO::Compress::Lzf::LzfError, + 'IO::Uncompress::UnLzf' => \$IO::Uncompress::UnLzf::UnLzfError, + 'IO::Uncompress::UnLzf::unlzf' => \$IO::Uncompress::UnLzf::UnLzfError, + 'IO::Compress::PPMd' => \$IO::Compress::PPMd::PPMdError, + 'IO::Compress::PPMd::ppmd' => \$IO::Compress::PPMd::PPMdError, + 'IO::Uncompress::UnPPMd' => \$IO::Uncompress::UnPPMd::UnPPMdError, + 'IO::Uncompress::UnPPMd::unppmd' => \$IO::Uncompress::UnPPMd::UnPPMdError, + + 'IO::Compress::DummyComp' => \$IO::Compress::DummyComp::DummyCompError, + 'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError, + 'IO::Uncompress::DummyUncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, + 'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, + ); + +my %TopFuncMap = ( 'IO::Compress::Gzip' => 'IO::Compress::Gzip::gzip', + 'IO::Uncompress::Gunzip' => 'IO::Uncompress::Gunzip::gunzip', + + 'IO::Compress::Deflate' => 'IO::Compress::Deflate::deflate', + 'IO::Uncompress::Inflate' => 'IO::Uncompress::Inflate::inflate', + + 'IO::Compress::RawDeflate' => 'IO::Compress::RawDeflate::rawdeflate', + 'IO::Uncompress::RawInflate' => 'IO::Uncompress::RawInflate::rawinflate', + + 'IO::Uncompress::AnyInflate' => 'IO::Uncompress::AnyInflate::anyinflate', + 'IO::Uncompress::AnyUncompress' => 'IO::Uncompress::AnyUncompress::anyuncompress', + + 'IO::Compress::Bzip2' => 'IO::Compress::Bzip2::bzip2', + 'IO::Uncompress::Bunzip2' => 'IO::Uncompress::Bunzip2::bunzip2', + + 'IO::Compress::Zip' => 'IO::Compress::Zip::zip', + 'IO::Uncompress::Unzip' => 'IO::Uncompress::Unzip::unzip', + 'IO::Compress::Lzop' => 'IO::Compress::Lzop::lzop', + 'IO::Uncompress::UnLzop' => 'IO::Uncompress::UnLzop::unlzop', + 'IO::Compress::Lzf' => 'IO::Compress::Lzf::lzf', + 'IO::Uncompress::UnLzf' => 'IO::Uncompress::UnLzf::unlzf', + 'IO::Compress::PPMd' => 'IO::Compress::PPMd::ppmd', + 'IO::Uncompress::UnPPMd' => 'IO::Uncompress::UnPPMd::unppmd', + 'IO::Compress::DummyComp' => 'IO::Compress::DummyComp::dummyuncomp', + 'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', + ); + + %TopFuncMap = map { ($_ => $TopFuncMap{$_}, + $TopFuncMap{$_} => $TopFuncMap{$_}) } + keys %TopFuncMap ; + + #%TopFuncMap = map { ($_ => \&{ $TopFuncMap{$_} ) } + #keys %TopFuncMap ; + + +my %inverse = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gunzip', + 'IO::Compress::Gzip::gzip' => 'IO::Uncompress::Gunzip::gunzip', + 'IO::Compress::Deflate' => 'IO::Uncompress::Inflate', + 'IO::Compress::Deflate::deflate' => 'IO::Uncompress::Inflate::inflate', + 'IO::Compress::RawDeflate' => 'IO::Uncompress::RawInflate', + 'IO::Compress::RawDeflate::rawdeflate' => 'IO::Uncompress::RawInflate::rawinflate', + 'IO::Compress::Bzip2::bzip2' => 'IO::Uncompress::Bunzip2::bunzip2', + 'IO::Compress::Bzip2' => 'IO::Uncompress::Bunzip2', + 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip::unzip', + 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', + 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop::unlzop', + 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf::unlzf', + 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf', + 'IO::Compress::PPMd::ppmd' => 'IO::Uncompress::UnPPMd::unppmd', + 'IO::Compress::PPMd' => 'IO::Uncompress::UnPPMd', + 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', + 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', + ); + +%inverse = map { ($_ => $inverse{$_}, $inverse{$_} => $_) } keys %inverse; + +sub getInverse +{ + my $class = shift ; + + return $inverse{$class} ; +} + +sub getErrorRef +{ + my $class = shift ; + + return $ErrorMap{$class} ; +} + +sub getTopFuncRef +{ + my $class = shift ; + + return \&{ $TopFuncMap{$class} } ; +} + +sub getTopFuncName +{ + my $class = shift ; + + return $TopFuncMap{$class} ; +} + +sub compressBuffer +{ + my $compWith = shift ; + my $buffer = shift ; + + my %mapping = ( 'IO::Uncompress::Gunzip' => 'IO::Compress::Gzip', + 'IO::Uncompress::Gunzip::gunzip' => 'IO::Compress::Gzip', + 'IO::Uncompress::Inflate' => 'IO::Compress::Deflate', + 'IO::Uncompress::Inflate::inflate' => 'IO::Compress::Deflate', + 'IO::Uncompress::RawInflate' => 'IO::Compress::RawDeflate', + 'IO::Uncompress::RawInflate::rawinflate' => 'IO::Compress::RawDeflate', + 'IO::Uncompress::Bunzip2' => 'IO::Compress::Bzip2', + 'IO::Uncompress::Bunzip2::bunzip2' => 'IO::Compress::Bzip2', + 'IO::Uncompress::Unzip' => 'IO::Compress::Zip', + 'IO::Uncompress::Unzip::unzip' => 'IO::Compress::Zip', + 'IO::Uncompress::UnLzop' => 'IO::Compress::Lzop', + 'IO::Uncompress::UnLzop::unlzop' => 'IO::Compress::Lzop', + 'IO::Uncompress::UnLzp' => 'IO::Compress::Lzf', + 'IO::Uncompress::UnLzf::unlzf' => 'IO::Compress::Lzf', + 'IO::Uncompress::UnPPMd' => 'IO::Compress::PPMd', + 'IO::Uncompress::UnPPMd::unppmd' => 'IO::Compress::PPMd', + 'IO::Uncompress::AnyInflate' => 'IO::Compress::Gzip', + 'IO::Uncompress::AnyInflate::anyinflate' => 'IO::Compress::Gzip', + 'IO::Uncompress::AnyUncompress' => 'IO::Compress::Gzip', + 'IO::Uncompress::AnyUncompress::anyuncompress' => 'IO::Compress::Gzip', + 'IO::Uncompress::DummyUncomp' => 'IO::Compress::DummyComp', + 'IO::Uncompress::DummyUncomp::dummyuncomp'=> 'IO::Compress::DummyComp', + ); + + my $out ; + my $obj = $mapping{$compWith}->new( \$out); + $obj->write($buffer) ; + $obj->close(); + return $out ; +} + +our ($AnyUncompressError); +BEGIN +{ + eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); '; +} + +sub anyUncompress +{ + my $buffer = shift ; + my $already = shift; + + my @opts = (); + if (ref $buffer && ref $buffer eq 'ARRAY') + { + @opts = @$buffer; + $buffer = shift @opts; + } + + if (ref $buffer) + { + croak "buffer is undef" unless defined $$buffer; + croak "buffer is empty" unless length $$buffer; + + } + + + my $data ; + if (IO::Compress::Base::Common::isaFilehandle($buffer)) + { + $data = readFile($buffer); + } + elsif (IO::Compress::Base::Common::isaFilename($buffer)) + { + $data = readFile($buffer); + } + else + { + $data = $$buffer ; + } + + if (defined $already && length $already) + { + + my $got = substr($data, 0, length($already)); + substr($data, 0, length($already)) = ''; + + is $got, $already, ' Already OK' ; + } + + my $out = ''; + my $o = new IO::Uncompress::AnyUncompress \$data, + Append => 1, + Transparent => 0, + RawInflate => 1, + @opts + or croak "Cannot open buffer/file: $AnyUncompressError" ; + + 1 while $o->read($out) > 0 ; + + croak "Error uncompressing -- " . $o->error() + if $o->error() ; + + return $out ; + +} + +sub getHeaders +{ + my $buffer = shift ; + my $already = shift; + + my @opts = (); + if (ref $buffer && ref $buffer eq 'ARRAY') + { + @opts = @$buffer; + $buffer = shift @opts; + } + + if (ref $buffer) + { + croak "buffer is undef" unless defined $$buffer; + croak "buffer is empty" unless length $$buffer; + + } + + + my $data ; + if (IO::Compress::Base::Common::isaFilehandle($buffer)) + { + $data = readFile($buffer); + } + elsif (IO::Compress::Base::Common::isaFilename($buffer)) + { + $data = readFile($buffer); + } + else + { + $data = $$buffer ; + } + + if (defined $already && length $already) + { + + my $got = substr($data, 0, length($already)); + substr($data, 0, length($already)) = ''; + + is $got, $already, ' Already OK' ; + } + + my $out = ''; + my $o = new IO::Uncompress::AnyUncompress \$data, + MultiStream => 1, + Append => 1, + Transparent => 0, + RawInflate => 1, + @opts + or croak "Cannot open buffer/file: $AnyUncompressError" ; + + 1 while $o->read($out) > 0 ; + + croak "Error uncompressing -- " . $o->error() + if $o->error() ; + + return ($o->getHeaderInfo()) ; + +} + +sub mkComplete +{ + my $class = shift ; + my $data = shift; + my $Error = getErrorRef($class); + + my $buffer ; + my %params = (); + + if ($class eq 'IO::Compress::Gzip') { + %params = ( + Name => "My name", + Comment => "a comment", + ExtraField => ['ab' => "extra"], + HeaderCRC => 1); + } + elsif ($class eq 'IO::Compress::Zip'){ + %params = ( + Name => "My name", + Comment => "a comment", + ZipComment => "last comment", + exTime => [100, 200, 300], + ExtraFieldLocal => ["ab" => "extra1"], + ExtraFieldCentral => ["cd" => "extra2"], + ); + } + + my $z = new $class( \$buffer, %params) + or croak "Cannot create $class object: $$Error"; + $z->write($data); + $z->close(); + + my $unc = getInverse($class); + anyUncompress(\$buffer) eq $data + or die "bad bad bad"; + my $u = new $unc( \$buffer); + my $info = $u->getHeaderInfo() ; + + + return wantarray ? ($info, $buffer) : $buffer ; +} + +sub mkErr +{ + my $string = shift ; + my ($dummy, $file, $line) = caller ; + -- $line ; + + $file = quotemeta($file); + + return "/$string\\s+at $file line $line/" if $] >= 5.006 ; + return "/$string\\s+at /" ; +} + +sub mkEvalErr +{ + my $string = shift ; + + return "/$string\\s+at \\(eval /" if $] > 5.006 ; + return "/$string\\s+at /" ; +} + +sub dumpObj +{ + my $obj = shift ; + + my ($dummy, $file, $line) = caller ; + + if (@_) + { + print "#\n# dumpOBJ from $file line $line @_\n" ; + } + else + { + print "#\n# dumpOBJ from $file line $line \n" ; + } + + my $max = 0 ;; + foreach my $k (keys %{ *$obj }) + { + $max = length $k if length $k > $max ; + } + + foreach my $k (sort keys %{ *$obj }) + { + my $v = $obj->{$k} ; + $v = '-undef-' unless defined $v; + my $pad = ' ' x ($max - length($k) + 2) ; + print "# $k$pad: [$v]\n"; + } + print "#\n" ; +} + + +sub getMultiValues +{ + my $class = shift ; + + return (0,0) if $class =~ /lzf/i; + return (1,0); +} + + +sub gotScalarUtilXS +{ + eval ' use Scalar::Util "dualvar" '; + return $@ ? 0 : 1 ; +} + +package CompTestUtils; + +1; +__END__ + t/Test/Builder.pm + t/Test/More.pm + t/Test/Simple.pm + t/compress/CompTestUtils.pm + t/compress/any.pl + t/compress/anyunc.pl + t/compress/destroy.pl + t/compress/generic.pl + t/compress/merge.pl + t/compress/multi.pl + t/compress/newtied.pl + t/compress/oneshot.pl + t/compress/prime.pl + t/compress/tied.pl + t/compress/truncate.pl + t/compress/zlib-generic.plParsing config.in... +Building Zlib enabled +Auto Detect Gzip OS Code.. +Setting Gzip OS Code to 3 [Unix/Default] +Looks Good. diff --git a/ext/Cwd/t/cwd.t b/ext/Cwd/t/cwd.t index 8e86c4dece..bab3dc372b 100644 --- a/ext/Cwd/t/cwd.t +++ b/ext/Cwd/t/cwd.t @@ -1,15 +1,11 @@ #!./perl -w -BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} +use strict; + use Cwd; + chdir 't'; -use strict; use Config; use File::Spec; use File::Path; diff --git a/ext/Cwd/t/taint.t b/ext/Cwd/t/taint.t index c92dbe3eb1..60cbfebc41 100644 --- a/ext/Cwd/t/taint.t +++ b/ext/Cwd/t/taint.t @@ -3,14 +3,8 @@ use strict; -BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} use Cwd; -chdir 't'; +chdir 't' unless $ENV{PERL_CORE}; use File::Spec; use lib File::Spec->catdir('t', 'lib'); diff --git a/ext/Cwd/t/win32.t b/ext/Cwd/t/win32.t index 2934c81671..3fa5cb86ab 100644 --- a/ext/Cwd/t/win32.t +++ b/ext/Cwd/t/win32.t @@ -1,11 +1,5 @@ #!./perl -BEGIN { - if ($ENV{PERL_CORE}) { - @INC = '../lib'; - } -} - use File::Spec; use lib File::Spec->catdir('t', 'lib'); use Test::More; diff --git a/ext/DB_File/t/db-btree.t b/ext/DB_File/t/db-btree.t index d6966da6a0..0df890436b 100644 --- a/ext/DB_File/t/db-btree.t +++ b/ext/DB_File/t/db-btree.t @@ -1,18 +1,11 @@ #!./perl -w - -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib' if -d '../lib'; - } -} use warnings; use strict; use Config; BEGIN { - if(-d "lib" && -f "TEST") { + if($ENV{PERL_CORE}) { if ($Config{'extensions'} !~ /\bDB_File\b/ ) { print "1..0 # Skip: DB_File was not built\n"; exit 0; diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t index 889bbe91ff..4168362531 100644 --- a/ext/DB_File/t/db-hash.t +++ b/ext/DB_File/t/db-hash.t @@ -1,18 +1,11 @@ #!./perl - -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib' if -d '../lib'; - } -} use warnings; use strict; use Config; BEGIN { - if(-d "lib" && -f "TEST") { + if($ENV{PERL_CORE}) { if ($Config{'extensions'} !~ /\bDB_File\b/ ) { print "1..0 # Skip: DB_File was not built\n"; exit 0; diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t index 3eb69688b7..365abfd520 100644 --- a/ext/DB_File/t/db-recno.t +++ b/ext/DB_File/t/db-recno.t @@ -1,18 +1,11 @@ #!./perl -w - -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib' if -d '../lib'; - } -} use warnings; use strict; use Config; BEGIN { - if(-d "lib" && -f "TEST") { + if($ENV{PERL_CORE}) { if ($Config{'extensions'} !~ /\bDB_File\b/ ) { print "1..0 # Skip: DB_File was not built\n"; exit 0; diff --git a/t/lib/dprof/V.pm b/ext/Devel-DProf/dprof/V.pm index 152cddc253..e613f6f441 100644 --- a/t/lib/dprof/V.pm +++ b/ext/Devel-DProf/dprof/V.pm @@ -12,7 +12,7 @@ require Exporter; $num = 0; $results = $expected = ''; $perl = $opt_p || $^X; -$dpp = $opt_d || '../utils/dprofpp'; +$dpp = $opt_d || '../../utils/dprofpp'; $dpp .= '.com' if $^O eq 'VMS'; print "\nperl: $perl\n" if $opt_v; diff --git a/t/lib/dprof/test1_t b/ext/Devel-DProf/dprof/test1_t index d504cd5536..d504cd5536 100644 --- a/t/lib/dprof/test1_t +++ b/ext/Devel-DProf/dprof/test1_t diff --git a/t/lib/dprof/test1_v b/ext/Devel-DProf/dprof/test1_v index 542a503414..542a503414 100644 --- a/t/lib/dprof/test1_v +++ b/ext/Devel-DProf/dprof/test1_v diff --git a/t/lib/dprof/test2_t b/ext/Devel-DProf/dprof/test2_t index edc46c527e..edc46c527e 100644 --- a/t/lib/dprof/test2_t +++ b/ext/Devel-DProf/dprof/test2_t diff --git a/t/lib/dprof/test2_v b/ext/Devel-DProf/dprof/test2_v index 8b775b3131..8b775b3131 100644 --- a/t/lib/dprof/test2_v +++ b/ext/Devel-DProf/dprof/test2_v diff --git a/t/lib/dprof/test3_t b/ext/Devel-DProf/dprof/test3_t index a5327f4d7a..a5327f4d7a 100644 --- a/t/lib/dprof/test3_t +++ b/ext/Devel-DProf/dprof/test3_t diff --git a/t/lib/dprof/test3_v b/ext/Devel-DProf/dprof/test3_v index df7543e2b8..df7543e2b8 100644 --- a/t/lib/dprof/test3_v +++ b/ext/Devel-DProf/dprof/test3_v diff --git a/t/lib/dprof/test4_t b/ext/Devel-DProf/dprof/test4_t index 729968270a..729968270a 100644 --- a/t/lib/dprof/test4_t +++ b/ext/Devel-DProf/dprof/test4_t diff --git a/t/lib/dprof/test4_v b/ext/Devel-DProf/dprof/test4_v index d9677ff785..d9677ff785 100644 --- a/t/lib/dprof/test4_v +++ b/ext/Devel-DProf/dprof/test4_v diff --git a/t/lib/dprof/test5_t b/ext/Devel-DProf/dprof/test5_t index 0b1113757f..0b1113757f 100644 --- a/t/lib/dprof/test5_t +++ b/ext/Devel-DProf/dprof/test5_t diff --git a/t/lib/dprof/test5_v b/ext/Devel-DProf/dprof/test5_v index 9e9298c689..9e9298c689 100644 --- a/t/lib/dprof/test5_v +++ b/ext/Devel-DProf/dprof/test5_v diff --git a/t/lib/dprof/test6_t b/ext/Devel-DProf/dprof/test6_t index 7b8bf4a722..7b8bf4a722 100644 --- a/t/lib/dprof/test6_t +++ b/ext/Devel-DProf/dprof/test6_t diff --git a/t/lib/dprof/test6_v b/ext/Devel-DProf/dprof/test6_v index 2f651ea794..2f651ea794 100644 --- a/t/lib/dprof/test6_v +++ b/ext/Devel-DProf/dprof/test6_v diff --git a/t/lib/dprof/test7_t b/ext/Devel-DProf/dprof/test7_t index 56dbfd341c..56dbfd341c 100644 --- a/t/lib/dprof/test7_t +++ b/ext/Devel-DProf/dprof/test7_t diff --git a/t/lib/dprof/test7_v b/ext/Devel-DProf/dprof/test7_v index 1d19fe5cd5..1d19fe5cd5 100644 --- a/t/lib/dprof/test7_v +++ b/ext/Devel-DProf/dprof/test7_v diff --git a/t/lib/dprof/test8_t b/ext/Devel-DProf/dprof/test8_t index 6154c8a530..6154c8a530 100644 --- a/t/lib/dprof/test8_t +++ b/ext/Devel-DProf/dprof/test8_t diff --git a/t/lib/dprof/test8_v b/ext/Devel-DProf/dprof/test8_v index d5de3087fe..d5de3087fe 100644 --- a/t/lib/dprof/test8_v +++ b/ext/Devel-DProf/dprof/test8_v diff --git a/ext/Devel-DProf/t/DProf.t b/ext/Devel-DProf/t/DProf.t index afffaeaaa4..7d3a170bac 100644 --- a/ext/Devel-DProf/t/DProf.t +++ b/ext/Devel-DProf/t/DProf.t @@ -1,9 +1,7 @@ #!perl BEGIN { - chdir( 't' ) if -d 't'; - @INC = '../lib'; - require './test.pl'; # for which_perl() etc + require 'test.pl'; # for which_perl() etc require Config; import Config; if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){ print "1..0 # Skip: Devel::DProf was not built\n"; @@ -24,7 +22,7 @@ getopts('vI:p:'); # -I Add to @INC # -p Name of perl binary -@tests = @ARGV ? @ARGV : sort (<lib/dprof/*_t>, <lib/dprof/*_v>); # glob-sort, for OS/2 +@tests = @ARGV ? @ARGV : sort (<dprof/*_t>, <dprof/*_v>); # glob-sort, for OS/2 $path_sep = $Config{path_sep} || ':'; $perl5lib = $opt_I || join( $path_sep, @INC ); @@ -65,7 +63,7 @@ sub profile { sub verify { my $test = shift; - my $command = $perl.' "-I../lib" "-I./lib/dprof" '.$test; + my $command = $perl.' "-I./dprof" '.$test; $command .= ' -v' if $opt_v; $command .= ' -p '. $perl; system $command; diff --git a/ext/Devel-PPPort/mktests.PL b/ext/Devel-PPPort/mktests.PL index 98b80ed5e0..82ccab3238 100644 --- a/ext/Devel-PPPort/mktests.PL +++ b/ext/Devel-PPPort/mktests.PL @@ -77,8 +77,6 @@ __DATA__ BEGIN { if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; require Config; import Config; use vars '%Config'; if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { diff --git a/ext/Devel-PPPort/t/ppphtest.t b/ext/Devel-PPPort/t/ppphtest.t index fe4ade08e7..ae97b74171 100644 --- a/ext/Devel-PPPort/t/ppphtest.t +++ b/ext/Devel-PPPort/t/ppphtest.t @@ -12,8 +12,6 @@ BEGIN { if ($ENV{'PERL_CORE'}) { - chdir 't' if -d 't'; - @INC = ('../lib', '../ext/Devel-PPPort/t') if -d '../lib' && -d '../ext'; require Config; import Config; use vars '%Config'; if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) { diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index cf0f686d5d..4a4d27493d 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -1,8 +1,6 @@ #!./perl -T BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bDevel\/Peek\b/) { print "1..0 # Skip: Devel::Peek was not built\n"; @@ -10,7 +8,7 @@ BEGIN { } } -BEGIN { require "./test.pl"; } +BEGIN { require "../../t/test.pl"; } use Devel::Peek; diff --git a/ext/Digest-MD5/t/align.t b/ext/Digest-MD5/t/align.t index 90dfe8048e..bb1224628a 100644 --- a/ext/Digest-MD5/t/align.t +++ b/ext/Digest-MD5/t/align.t @@ -1,10 +1,3 @@ -BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - # Test that md5 works on unaligned memory blocks print "1..1\n"; diff --git a/ext/Digest-MD5/t/files.t b/ext/Digest-MD5/t/files.t index 26d64e3348..9da8895f55 100644 --- a/ext/Digest-MD5/t/files.t +++ b/ext/Digest-MD5/t/files.t @@ -1,10 +1,3 @@ -BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - print "1..3\n"; use strict; @@ -61,13 +54,6 @@ for (split /^/, $EXPECT) { print "ok ", ++$testno, " # Skip: PERL_CORE\n"; next; } - use File::Spec; - my @path = qw(ext Digest-MD5); - my $path = File::Spec->updir; - while (@path) { - $path = File::Spec->catdir($path, shift @path); - } - $file = File::Spec->catfile($path, $file); } # print "# file = $file\n"; unless (-f $file) { diff --git a/ext/Digest-MD5/t/md5-aaa.t b/ext/Digest-MD5/t/md5-aaa.t index 1ccd59b749..4b646546f0 100644 --- a/ext/Digest-MD5/t/md5-aaa.t +++ b/ext/Digest-MD5/t/md5-aaa.t @@ -1,10 +1,3 @@ -BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use strict; print "1..256\n"; diff --git a/ext/Encode/t/piconv.t b/ext/Encode/t/piconv.t deleted file mode 100644 index e477f044ee..0000000000 --- a/ext/Encode/t/piconv.t +++ /dev/null @@ -1,103 +0,0 @@ -# -# $Id: piconv.t,v 0.2 2009/07/13 00:50:52 dankogai Exp $ -# - -BEGIN { - if ( $ENV{'PERL_CORE'} ) { - print "1..0 # Skip: Don't know how to test this within perl's core\n"; - exit 0; - } -} - -use strict; -use FindBin; -use File::Spec; -use IPC::Open3 qw(open3); -use IO::Select; -use Test::More; - -my $WIN = $^O eq 'MSWin32'; - -if ($WIN) { - eval { require IPC::Run; IPC::Run->VERSION(0.83); 1; } or - plan skip_all => 'Win32 environments require IPC::Run 0.83 to complete this test'; -} - -sub run_cmd (;$$); - -my $blib = - File::Spec->rel2abs( - File::Spec->catdir( $FindBin::RealBin, File::Spec->updir, 'blib' ) ); -my $script = File::Spec->catdir($blib, 'script', 'piconv'); -my @base_cmd = ( $^X, "-Mblib=$blib", $script ); - -plan tests => 5; - -{ - my ( $st, $out, $err ) = run_cmd; - is( $st, 0, 'status for usage call' ); - is( $out, $WIN ? undef : '' ); - like( $err, qr{^piconv}, 'usage' ); -} - -{ - my($st, $out, $err) = run_cmd [qw(-S foobar -f utf-8 -t ascii), $script]; - like($err, qr{unknown scheme.*fallback}i, 'warning for unknown scheme'); -} - -{ - my ( $st, $out, $err ) = run_cmd [qw(-f utf-8 -t ascii ./non-existing/file)]; - like( $err, qr{can't open}i ); -} - -sub run_cmd (;$$) { - my ( $args, $in ) = @_; - - my $out = "x" x 10_000; - $out = ""; - my $err = "x" x 10_000; - $err = ""; - - if ($WIN) { - IPC::Run->import(qw(run timeout)); - my @cmd; - if (defined $args) { - @cmd = (@base_cmd, @$args); - } else { - @cmd = @base_cmd; - } - run(\@cmd, \$in, \$out, \$err, timeout(10)); - my $st = $?; - $out = undef if ($out eq ''); - ( $st, $out, $err ); - } else { - $in ||= ''; - my ( $in_fh, $out_fh, $err_fh ); - use Symbol 'gensym'; - $err_fh = - gensym; # sigh... otherwise stderr gets just to $out_fh, not to $err_fh - my $pid = open3( $in_fh, $out_fh, $err_fh, @base_cmd, @$args ) - or die "Can't run @base_cmd @$args: $!"; - print $in_fh $in; - my $sel = IO::Select->new( $out_fh, $err_fh ); - - while ( my @ready = $sel->can_read ) { - for my $fh (@ready) { - if ( eof($fh) ) { - $sel->remove($fh); - last if !$sel->handles; - } - elsif ( $out_fh == $fh ) { - my $line = <$fh>; - $out .= $line; - } - elsif ( $err_fh == $fh ) { - my $line = <$fh>; - $err .= $line; - } - } - } - my $st = $?; - ( $st, $out, $err ); - } -} diff --git a/ext/Errno/t/Errno.t b/ext/Errno/t/Errno.t index 16d5cb0de9..302bd8ddd6 100644 --- a/ext/Errno/t/Errno.t +++ b/ext/Errno/t/Errno.t @@ -1,16 +1,5 @@ #!./perl -w -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - if ($^O eq 'MacOS') { - @INC = qw(: ::lib ::macos:lib); - } else { - @INC = '../lib'; - } - } -} - use Test::More tests => 10; BEGIN { diff --git a/ext/Fcntl/t/fcntl.t b/ext/Fcntl/t/fcntl.t index d5d772f235..b689f781cc 100644 --- a/ext/Fcntl/t/fcntl.t +++ b/ext/Fcntl/t/fcntl.t @@ -1,10 +1,5 @@ #!./perl -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - # A modest test: exercises only O_WRONLY, O_CREAT, and O_RDONLY. # Have to be modest to be portable: could possibly extend testing # also to O_RDWR and O_APPEND, but dunno about the portability of, diff --git a/ext/Fcntl/t/mode.t b/ext/Fcntl/t/mode.t index 57135f6d38..57bd0c470c 100644 --- a/ext/Fcntl/t/mode.t +++ b/ext/Fcntl/t/mode.t @@ -1,9 +1,7 @@ #!./perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; - require './test.pl'; + require 'test.pl'; } plan tests => 2; diff --git a/ext/Fcntl/t/syslfs.t b/ext/Fcntl/t/syslfs.t index 0843b6019e..3417e443e4 100644 --- a/ext/Fcntl/t/syslfs.t +++ b/ext/Fcntl/t/syslfs.t @@ -3,8 +3,6 @@ # If you modify/add tests here, remember to update also t/op/lfs.t. BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; # Don't bother if there are no quad offsets. if ($Config{lseeksize} < 8) { diff --git a/t/lib/filter-util.pl b/ext/Filter-Util-Call/filter-util.pl index 1bc3bfbd93..1bc3bfbd93 100644 --- a/t/lib/filter-util.pl +++ b/ext/Filter-Util-Call/filter-util.pl diff --git a/ext/Filter-Util-Call/t/call.t b/ext/Filter-Util-Call/t/call.t index b1c7c05dad..5fa7e38b53 100644 --- a/ext/Filter-Util-Call/t/call.t +++ b/ext/Filter-Util-Call/t/call.t @@ -1,19 +1,13 @@ BEGIN { if ($ENV{PERL_CORE}){ - chdir('t') if -d 't'; - @INC = ('.', '../lib'); - require Config; import Config; %Config=%Config if 0; # cease -w if ($Config{'extensions'} !~ m{\bFilter/Util/Call\b}) { print "1..0 # Skip: Filter::Util::Call was not built\n"; exit 0; } - require 'lib/filter-util.pl'; - } - else { - require 'filter-util.pl'; } + require 'filter-util.pl'; } use strict; diff --git a/ext/GDBM_File/t/gdbm.t b/ext/GDBM_File/t/gdbm.t index 53a2ae5d9d..c0addb0cf2 100644 --- a/ext/GDBM_File/t/gdbm.t +++ b/ext/GDBM_File/t/gdbm.t @@ -3,8 +3,6 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bGDBM_File\b/) { print "1..0 # Skip: GDBM_File was not built\n"; diff --git a/ext/IO-Compress/t/compress/CompTestUtils.pm b/ext/IO-Compress/t/compress/CompTestUtils.pm new file mode 100644 index 0000000000..22b6d5646c --- /dev/null +++ b/ext/IO-Compress/t/compress/CompTestUtils.pm @@ -0,0 +1,669 @@ +package CompTestUtils; + +package main ; + +use strict ; +use warnings; +use bytes; + +#use lib qw(t t/compress); + +use Carp ; +#use Test::More ; + + + +sub title +{ + #diag "" ; + ok 1, $_[0] ; + #diag "" ; +} + +sub like_eval +{ + like $@, @_ ; +} + +{ + package LexFile ; + + our ($index); + $index = '00000'; + + sub new + { + my $self = shift ; + foreach (@_) + { + # autogenerate the name unless if none supplied + $_ = "tst" . $index ++ . ".tmp" + unless defined $_; + } + chmod 0777, @_; + for (@_) { 1 while unlink $_ } ; + bless [ @_ ], $self ; + } + + sub DESTROY + { + my $self = shift ; + chmod 0777, @{ $self } ; + for (@$self) { 1 while unlink $_ } ; + } + +} + +{ + package LexDir ; + + use File::Path; + sub new + { + my $self = shift ; + foreach (@_) { rmtree $_ } + bless [ @_ ], $self ; + } + + sub DESTROY + { + my $self = shift ; + foreach (@$self) { rmtree $_ } + } +} +sub readFile +{ + my $f = shift ; + + my @strings ; + + if (IO::Compress::Base::Common::isaFilehandle($f)) + { + my $pos = tell($f); + seek($f, 0,0); + @strings = <$f> ; + seek($f, 0, $pos); + } + else + { + open (F, "<$f") + or croak "Cannot open $f: $!\n" ; + binmode F; + @strings = <F> ; + close F ; + } + + return @strings if wantarray ; + return join "", @strings ; +} + +sub touch +{ + foreach (@_) { writeFile($_, '') } +} + +sub writeFile +{ + my($filename, @strings) = @_ ; + 1 while unlink $filename ; + open (F, ">$filename") + or croak "Cannot open $filename: $!\n" ; + binmode F; + foreach (@strings) { + no warnings ; + print F $_ ; + } + close F ; +} + +sub GZreadFile +{ + my ($filename) = shift ; + + my ($uncomp) = "" ; + my $line = "" ; + my $fil = gzopen($filename, "rb") + or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ; + + $uncomp .= $line + while $fil->gzread($line) > 0; + + $fil->gzclose ; + return $uncomp ; +} + +sub hexDump +{ + my $d = shift ; + + if (IO::Compress::Base::Common::isaFilehandle($d)) + { + $d = readFile($d); + } + elsif (IO::Compress::Base::Common::isaFilename($d)) + { + $d = readFile($d); + } + else + { + $d = $$d ; + } + + my $offset = 0 ; + + $d = '' unless defined $d ; + #while (read(STDIN, $data, 16)) { + while (my $data = substr($d, 0, 16)) { + substr($d, 0, 16) = '' ; + printf "# %8.8lx ", $offset; + $offset += 16; + + my @array = unpack('C*', $data); + foreach (@array) { + printf('%2.2x ', $_); + } + print " " x (16 - @array) + if @array < 16 ; + $data =~ tr/\0-\37\177-\377/./; + print " $data\n"; + } + +} + +sub readHeaderInfo +{ + my $name = shift ; + my %opts = @_ ; + + my $string = <<EOM; +some text +EOM + + ok my $x = new IO::Compress::Gzip $name, %opts + or diag "GzipError is $IO::Compress::Gzip::GzipError" ; + ok $x->write($string) ; + ok $x->close ; + + #is GZreadFile($name), $string ; + + ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0 + or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; + ok my $hdr = $gunz->getHeaderInfo(); + my $uncomp ; + ok $gunz->read($uncomp) ; + ok $uncomp eq $string; + ok $gunz->close ; + + return $hdr ; +} + +sub cmpFile +{ + my ($filename, $uue) = @_ ; + return readFile($filename) eq unpack("u", $uue) ; +} + +sub isRawFormat +{ + my $class = shift; + my %raw = map { $_ => 1 } qw( RawDeflate ); + + return defined $raw{$class}; +} + +sub uncompressBuffer +{ + my $compWith = shift ; + my $buffer = shift ; + + my %mapping = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gunzip', + 'IO::Compress::Gzip::gzip' => 'IO::Uncompress::Gunzip', + 'IO::Compress::Deflate' => 'IO::Uncompress::Inflate', + 'IO::Compress::Deflate::deflate' => 'IO::Uncompress::Inflate', + 'IO::Compress::RawDeflate' => 'IO::Uncompress::RawInflate', + 'IO::Compress::RawDeflate::rawdeflate' => 'IO::Uncompress::RawInflate', + 'IO::Compress::Bzip2' => 'IO::Uncompress::Bunzip2', + 'IO::Compress::Bzip2::bzip2' => 'IO::Uncompress::Bunzip2', + 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', + 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip', + 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf' , + 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf', + 'IO::Compress::PPMd' => 'IO::Uncompress::UnPPMd' , + 'IO::Compress::PPMd::ppmd' => 'IO::Uncompress::UnPPMd', + 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', + 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp', + ); + + my $out ; + my $obj = $mapping{$compWith}->new( \$buffer, -Append => 1); + 1 while $obj->read($out) > 0 ; + return $out ; + +} + +my %ErrorMap = ( 'IO::Compress::Gzip' => \$IO::Compress::Gzip::GzipError, + 'IO::Compress::Gzip::gzip' => \$IO::Compress::Gzip::GzipError, + 'IO::Uncompress::Gunzip' => \$IO::Uncompress::Gunzip::GunzipError, + 'IO::Uncompress::Gunzip::gunzip' => \$IO::Uncompress::Gunzip::GunzipError, + 'IO::Uncompress::Inflate' => \$IO::Uncompress::Inflate::InflateError, + 'IO::Uncompress::Inflate::inflate' => \$IO::Uncompress::Inflate::InflateError, + 'IO::Compress::Deflate' => \$IO::Compress::Deflate::DeflateError, + 'IO::Compress::Deflate::deflate' => \$IO::Compress::Deflate::DeflateError, + 'IO::Uncompress::RawInflate' => \$IO::Uncompress::RawInflate::RawInflateError, + 'IO::Uncompress::RawInflate::rawinflate' => \$IO::Uncompress::RawInflate::RawInflateError, + 'IO::Uncompress::AnyInflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, + 'IO::Uncompress::AnyInflate::anyinflate' => \$IO::Uncompress::AnyInflate::AnyInflateError, + 'IO::Uncompress::AnyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, + 'IO::Uncompress::AnyUncompress::anyUncompress' => \$IO::Uncompress::AnyUncompress::AnyUncompressError, + 'IO::Compress::RawDeflate' => \$IO::Compress::RawDeflate::RawDeflateError, + 'IO::Compress::RawDeflate::rawdeflate' => \$IO::Compress::RawDeflate::RawDeflateError, + 'IO::Compress::Bzip2' => \$IO::Compress::Bzip2::Bzip2Error, + 'IO::Compress::Bzip2::bzip2' => \$IO::Compress::Bzip2::Bzip2Error, + 'IO::Uncompress::Bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, + 'IO::Uncompress::Bunzip2::bunzip2' => \$IO::Uncompress::Bunzip2::Bunzip2Error, + 'IO::Compress::Zip' => \$IO::Compress::Zip::ZipError, + 'IO::Compress::Zip::zip' => \$IO::Compress::Zip::ZipError, + 'IO::Uncompress::Unzip' => \$IO::Uncompress::Unzip::UnzipError, + 'IO::Uncompress::Unzip::unzip' => \$IO::Uncompress::Unzip::UnzipError, + 'IO::Compress::Lzop' => \$IO::Compress::Lzop::LzopError, + 'IO::Compress::Lzop::lzop' => \$IO::Compress::Lzop::LzopError, + 'IO::Uncompress::UnLzop' => \$IO::Uncompress::UnLzop::UnLzopError, + 'IO::Uncompress::UnLzop::unlzop' => \$IO::Uncompress::UnLzop::UnLzopError, + 'IO::Compress::Lzf' => \$IO::Compress::Lzf::LzfError, + 'IO::Compress::Lzf::lzf' => \$IO::Compress::Lzf::LzfError, + 'IO::Uncompress::UnLzf' => \$IO::Uncompress::UnLzf::UnLzfError, + 'IO::Uncompress::UnLzf::unlzf' => \$IO::Uncompress::UnLzf::UnLzfError, + 'IO::Compress::PPMd' => \$IO::Compress::PPMd::PPMdError, + 'IO::Compress::PPMd::ppmd' => \$IO::Compress::PPMd::PPMdError, + 'IO::Uncompress::UnPPMd' => \$IO::Uncompress::UnPPMd::UnPPMdError, + 'IO::Uncompress::UnPPMd::unppmd' => \$IO::Uncompress::UnPPMd::UnPPMdError, + + 'IO::Compress::DummyComp' => \$IO::Compress::DummyComp::DummyCompError, + 'IO::Compress::DummyComp::dummycomp'=> \$IO::Compress::DummyComp::DummyCompError, + 'IO::Uncompress::DummyUncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, + 'IO::Uncompress::DummyUncomp::dummyuncomp' => \$IO::Uncompress::DummyUncomp::DummyUncompError, + ); + +my %TopFuncMap = ( 'IO::Compress::Gzip' => 'IO::Compress::Gzip::gzip', + 'IO::Uncompress::Gunzip' => 'IO::Uncompress::Gunzip::gunzip', + + 'IO::Compress::Deflate' => 'IO::Compress::Deflate::deflate', + 'IO::Uncompress::Inflate' => 'IO::Uncompress::Inflate::inflate', + + 'IO::Compress::RawDeflate' => 'IO::Compress::RawDeflate::rawdeflate', + 'IO::Uncompress::RawInflate' => 'IO::Uncompress::RawInflate::rawinflate', + + 'IO::Uncompress::AnyInflate' => 'IO::Uncompress::AnyInflate::anyinflate', + 'IO::Uncompress::AnyUncompress' => 'IO::Uncompress::AnyUncompress::anyuncompress', + + 'IO::Compress::Bzip2' => 'IO::Compress::Bzip2::bzip2', + 'IO::Uncompress::Bunzip2' => 'IO::Uncompress::Bunzip2::bunzip2', + + 'IO::Compress::Zip' => 'IO::Compress::Zip::zip', + 'IO::Uncompress::Unzip' => 'IO::Uncompress::Unzip::unzip', + 'IO::Compress::Lzop' => 'IO::Compress::Lzop::lzop', + 'IO::Uncompress::UnLzop' => 'IO::Uncompress::UnLzop::unlzop', + 'IO::Compress::Lzf' => 'IO::Compress::Lzf::lzf', + 'IO::Uncompress::UnLzf' => 'IO::Uncompress::UnLzf::unlzf', + 'IO::Compress::PPMd' => 'IO::Compress::PPMd::ppmd', + 'IO::Uncompress::UnPPMd' => 'IO::Uncompress::UnPPMd::unppmd', + 'IO::Compress::DummyComp' => 'IO::Compress::DummyComp::dummyuncomp', + 'IO::Uncompress::DummyUncomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', + ); + + %TopFuncMap = map { ($_ => $TopFuncMap{$_}, + $TopFuncMap{$_} => $TopFuncMap{$_}) } + keys %TopFuncMap ; + + #%TopFuncMap = map { ($_ => \&{ $TopFuncMap{$_} ) } + #keys %TopFuncMap ; + + +my %inverse = ( 'IO::Compress::Gzip' => 'IO::Uncompress::Gunzip', + 'IO::Compress::Gzip::gzip' => 'IO::Uncompress::Gunzip::gunzip', + 'IO::Compress::Deflate' => 'IO::Uncompress::Inflate', + 'IO::Compress::Deflate::deflate' => 'IO::Uncompress::Inflate::inflate', + 'IO::Compress::RawDeflate' => 'IO::Uncompress::RawInflate', + 'IO::Compress::RawDeflate::rawdeflate' => 'IO::Uncompress::RawInflate::rawinflate', + 'IO::Compress::Bzip2::bzip2' => 'IO::Uncompress::Bunzip2::bunzip2', + 'IO::Compress::Bzip2' => 'IO::Uncompress::Bunzip2', + 'IO::Compress::Zip::zip' => 'IO::Uncompress::Unzip::unzip', + 'IO::Compress::Zip' => 'IO::Uncompress::Unzip', + 'IO::Compress::Lzop::lzop' => 'IO::Uncompress::UnLzop::unlzop', + 'IO::Compress::Lzop' => 'IO::Uncompress::UnLzop', + 'IO::Compress::Lzf::lzf' => 'IO::Uncompress::UnLzf::unlzf', + 'IO::Compress::Lzf' => 'IO::Uncompress::UnLzf', + 'IO::Compress::PPMd::ppmd' => 'IO::Uncompress::UnPPMd::unppmd', + 'IO::Compress::PPMd' => 'IO::Uncompress::UnPPMd', + 'IO::Compress::DummyComp::dummycomp' => 'IO::Uncompress::DummyUncomp::dummyuncomp', + 'IO::Compress::DummyComp' => 'IO::Uncompress::DummyUncomp', + ); + +%inverse = map { ($_ => $inverse{$_}, $inverse{$_} => $_) } keys %inverse; + +sub getInverse +{ + my $class = shift ; + + return $inverse{$class} ; +} + +sub getErrorRef +{ + my $class = shift ; + + return $ErrorMap{$class} ; +} + +sub getTopFuncRef +{ + my $class = shift ; + + return \&{ $TopFuncMap{$class} } ; +} + +sub getTopFuncName +{ + my $class = shift ; + + return $TopFuncMap{$class} ; +} + +sub compressBuffer +{ + my $compWith = shift ; + my $buffer = shift ; + + my %mapping = ( 'IO::Uncompress::Gunzip' => 'IO::Compress::Gzip', + 'IO::Uncompress::Gunzip::gunzip' => 'IO::Compress::Gzip', + 'IO::Uncompress::Inflate' => 'IO::Compress::Deflate', + 'IO::Uncompress::Inflate::inflate' => 'IO::Compress::Deflate', + 'IO::Uncompress::RawInflate' => 'IO::Compress::RawDeflate', + 'IO::Uncompress::RawInflate::rawinflate' => 'IO::Compress::RawDeflate', + 'IO::Uncompress::Bunzip2' => 'IO::Compress::Bzip2', + 'IO::Uncompress::Bunzip2::bunzip2' => 'IO::Compress::Bzip2', + 'IO::Uncompress::Unzip' => 'IO::Compress::Zip', + 'IO::Uncompress::Unzip::unzip' => 'IO::Compress::Zip', + 'IO::Uncompress::UnLzop' => 'IO::Compress::Lzop', + 'IO::Uncompress::UnLzop::unlzop' => 'IO::Compress::Lzop', + 'IO::Uncompress::UnLzp' => 'IO::Compress::Lzf', + 'IO::Uncompress::UnLzf::unlzf' => 'IO::Compress::Lzf', + 'IO::Uncompress::UnPPMd' => 'IO::Compress::PPMd', + 'IO::Uncompress::UnPPMd::unppmd' => 'IO::Compress::PPMd', + 'IO::Uncompress::AnyInflate' => 'IO::Compress::Gzip', + 'IO::Uncompress::AnyInflate::anyinflate' => 'IO::Compress::Gzip', + 'IO::Uncompress::AnyUncompress' => 'IO::Compress::Gzip', + 'IO::Uncompress::AnyUncompress::anyuncompress' => 'IO::Compress::Gzip', + 'IO::Uncompress::DummyUncomp' => 'IO::Compress::DummyComp', + 'IO::Uncompress::DummyUncomp::dummyuncomp'=> 'IO::Compress::DummyComp', + ); + + my $out ; + my $obj = $mapping{$compWith}->new( \$out); + $obj->write($buffer) ; + $obj->close(); + return $out ; +} + +our ($AnyUncompressError); +BEGIN +{ + eval ' use IO::Uncompress::AnyUncompress qw($AnyUncompressError); '; +} + +sub anyUncompress +{ + my $buffer = shift ; + my $already = shift; + + my @opts = (); + if (ref $buffer && ref $buffer eq 'ARRAY') + { + @opts = @$buffer; + $buffer = shift @opts; + } + + if (ref $buffer) + { + croak "buffer is undef" unless defined $$buffer; + croak "buffer is empty" unless length $$buffer; + + } + + + my $data ; + if (IO::Compress::Base::Common::isaFilehandle($buffer)) + { + $data = readFile($buffer); + } + elsif (IO::Compress::Base::Common::isaFilename($buffer)) + { + $data = readFile($buffer); + } + else + { + $data = $$buffer ; + } + + if (defined $already && length $already) + { + + my $got = substr($data, 0, length($already)); + substr($data, 0, length($already)) = ''; + + is $got, $already, ' Already OK' ; + } + + my $out = ''; + my $o = new IO::Uncompress::AnyUncompress \$data, + Append => 1, + Transparent => 0, + RawInflate => 1, + @opts + or croak "Cannot open buffer/file: $AnyUncompressError" ; + + 1 while $o->read($out) > 0 ; + + croak "Error uncompressing -- " . $o->error() + if $o->error() ; + + return $out ; + +} + +sub getHeaders +{ + my $buffer = shift ; + my $already = shift; + + my @opts = (); + if (ref $buffer && ref $buffer eq 'ARRAY') + { + @opts = @$buffer; + $buffer = shift @opts; + } + + if (ref $buffer) + { + croak "buffer is undef" unless defined $$buffer; + croak "buffer is empty" unless length $$buffer; + + } + + + my $data ; + if (IO::Compress::Base::Common::isaFilehandle($buffer)) + { + $data = readFile($buffer); + } + elsif (IO::Compress::Base::Common::isaFilename($buffer)) + { + $data = readFile($buffer); + } + else + { + $data = $$buffer ; + } + + if (defined $already && length $already) + { + + my $got = substr($data, 0, length($already)); + substr($data, 0, length($already)) = ''; + + is $got, $already, ' Already OK' ; + } + + my $out = ''; + my $o = new IO::Uncompress::AnyUncompress \$data, + MultiStream => 1, + Append => 1, + Transparent => 0, + RawInflate => 1, + @opts + or croak "Cannot open buffer/file: $AnyUncompressError" ; + + 1 while $o->read($out) > 0 ; + + croak "Error uncompressing -- " . $o->error() + if $o->error() ; + + return ($o->getHeaderInfo()) ; + +} + +sub mkComplete +{ + my $class = shift ; + my $data = shift; + my $Error = getErrorRef($class); + + my $buffer ; + my %params = (); + + if ($class eq 'IO::Compress::Gzip') { + %params = ( + Name => "My name", + Comment => "a comment", + ExtraField => ['ab' => "extra"], + HeaderCRC => 1); + } + elsif ($class eq 'IO::Compress::Zip'){ + %params = ( + Name => "My name", + Comment => "a comment", + ZipComment => "last comment", + exTime => [100, 200, 300], + ExtraFieldLocal => ["ab" => "extra1"], + ExtraFieldCentral => ["cd" => "extra2"], + ); + } + + my $z = new $class( \$buffer, %params) + or croak "Cannot create $class object: $$Error"; + $z->write($data); + $z->close(); + + my $unc = getInverse($class); + anyUncompress(\$buffer) eq $data + or die "bad bad bad"; + my $u = new $unc( \$buffer); + my $info = $u->getHeaderInfo() ; + + + return wantarray ? ($info, $buffer) : $buffer ; +} + +sub mkErr +{ + my $string = shift ; + my ($dummy, $file, $line) = caller ; + -- $line ; + + $file = quotemeta($file); + + return "/$string\\s+at $file line $line/" if $] >= 5.006 ; + return "/$string\\s+at /" ; +} + +sub mkEvalErr +{ + my $string = shift ; + + return "/$string\\s+at \\(eval /" if $] > 5.006 ; + return "/$string\\s+at /" ; +} + +sub dumpObj +{ + my $obj = shift ; + + my ($dummy, $file, $line) = caller ; + + if (@_) + { + print "#\n# dumpOBJ from $file line $line @_\n" ; + } + else + { + print "#\n# dumpOBJ from $file line $line \n" ; + } + + my $max = 0 ;; + foreach my $k (keys %{ *$obj }) + { + $max = length $k if length $k > $max ; + } + + foreach my $k (sort keys %{ *$obj }) + { + my $v = $obj->{$k} ; + $v = '-undef-' unless defined $v; + my $pad = ' ' x ($max - length($k) + 2) ; + print "# $k$pad: [$v]\n"; + } + print "#\n" ; +} + + +sub getMultiValues +{ + my $class = shift ; + + return (0,0) if $class =~ /lzf/i; + return (1,0); +} + + +sub gotScalarUtilXS +{ + eval ' use Scalar::Util "dualvar" '; + return $@ ? 0 : 1 ; +} + +package CompTestUtils; + +1; +__END__ + t/Test/Builder.pm + t/Test/More.pm + t/Test/Simple.pm + t/compress/CompTestUtils.pm + t/compress/any.pl + t/compress/anyunc.pl + t/compress/destroy.pl + t/compress/generic.pl + t/compress/merge.pl + t/compress/multi.pl + t/compress/newtied.pl + t/compress/oneshot.pl + t/compress/prime.pl + t/compress/tied.pl + t/compress/truncate.pl + t/compress/zlib-generic.plParsing config.in... +Building Zlib enabled +Auto Detect Gzip OS Code.. +Setting Gzip OS Code to 3 [Unix/Default] +Looks Good. diff --git a/t/lib/compress/any.pl b/ext/IO-Compress/t/compress/any.pl index d95766b0a9..d95766b0a9 100644 --- a/t/lib/compress/any.pl +++ b/ext/IO-Compress/t/compress/any.pl diff --git a/t/lib/compress/anyunc.pl b/ext/IO-Compress/t/compress/anyunc.pl index 2860e2571c..2860e2571c 100644 --- a/t/lib/compress/anyunc.pl +++ b/ext/IO-Compress/t/compress/anyunc.pl diff --git a/t/lib/compress/destroy.pl b/ext/IO-Compress/t/compress/destroy.pl index 186520df16..186520df16 100644 --- a/t/lib/compress/destroy.pl +++ b/ext/IO-Compress/t/compress/destroy.pl diff --git a/t/lib/compress/encode.pl b/ext/IO-Compress/t/compress/encode.pl index 142bd08e59..142bd08e59 100644 --- a/t/lib/compress/encode.pl +++ b/ext/IO-Compress/t/compress/encode.pl diff --git a/t/lib/compress/generic.pl b/ext/IO-Compress/t/compress/generic.pl index 54abab0a54..54abab0a54 100644 --- a/t/lib/compress/generic.pl +++ b/ext/IO-Compress/t/compress/generic.pl diff --git a/t/lib/compress/merge.pl b/ext/IO-Compress/t/compress/merge.pl index 6134292466..6134292466 100644 --- a/t/lib/compress/merge.pl +++ b/ext/IO-Compress/t/compress/merge.pl diff --git a/t/lib/compress/multi.pl b/ext/IO-Compress/t/compress/multi.pl index 3e9bbfd464..3e9bbfd464 100644 --- a/t/lib/compress/multi.pl +++ b/ext/IO-Compress/t/compress/multi.pl diff --git a/t/lib/compress/newtied.pl b/ext/IO-Compress/t/compress/newtied.pl index 41861e9072..41861e9072 100644 --- a/t/lib/compress/newtied.pl +++ b/ext/IO-Compress/t/compress/newtied.pl diff --git a/t/lib/compress/oneshot.pl b/ext/IO-Compress/t/compress/oneshot.pl index 4f8bb83ac6..4f8bb83ac6 100644 --- a/t/lib/compress/oneshot.pl +++ b/ext/IO-Compress/t/compress/oneshot.pl diff --git a/t/lib/compress/prime.pl b/ext/IO-Compress/t/compress/prime.pl index 4e804e5b00..4e804e5b00 100644 --- a/t/lib/compress/prime.pl +++ b/ext/IO-Compress/t/compress/prime.pl diff --git a/t/lib/compress/tied.pl b/ext/IO-Compress/t/compress/tied.pl index 80d42b7561..80d42b7561 100644 --- a/t/lib/compress/tied.pl +++ b/ext/IO-Compress/t/compress/tied.pl diff --git a/t/lib/compress/truncate.pl b/ext/IO-Compress/t/compress/truncate.pl index b362fd3b6e..b362fd3b6e 100644 --- a/t/lib/compress/truncate.pl +++ b/ext/IO-Compress/t/compress/truncate.pl diff --git a/t/lib/compress/zlib-generic.pl b/ext/IO-Compress/t/compress/zlib-generic.pl index 94e5da9f72..94e5da9f72 100644 --- a/t/lib/compress/zlib-generic.pl +++ b/ext/IO-Compress/t/compress/zlib-generic.pl diff --git a/ext/IO/t/IO.t b/ext/IO/t/IO.t index ae67a2579a..effd414a4c 100644 --- a/ext/IO/t/IO.t +++ b/ext/IO/t/IO.t @@ -1,21 +1,19 @@ #!/usr/bin/perl -w BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } + if ($ENV{PERL_CORE}) { require Config; if ($Config::Config{'extensions'} !~ /\bSocket\b/) { print "1..0 # Skip: Socket not built - IO.pm uses Socket"; exit 0; } + } } use strict; use File::Path; use File::Spec; -require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl"); +require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); plan(tests => 18); { diff --git a/ext/IO/t/io_const.t b/ext/IO/t/io_const.t index 13bb65c0b4..f6f83c1956 100644 --- a/ext/IO/t/io_const.t +++ b/ext/IO/t/io_const.t @@ -1,11 +1,3 @@ - -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use Config; BEGIN { diff --git a/ext/IO/t/io_dir.t b/ext/IO/t/io_dir.t index 10202b581e..5472daa9b9 100644 --- a/ext/IO/t/io_dir.t +++ b/ext/IO/t/io_dir.t @@ -1,17 +1,15 @@ #!./perl BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } - require Config; import Config; - if ($] < 5.00326 || not $Config{'d_readdir'}) { - print "1..0 # Skip: readdir() not available\n"; - exit 0; + if ($ENV{PERL_CORE}) { + require Config; import Config; + if ($] < 5.00326 || not $Config{'d_readdir'}) { + print "1..0 # Skip: readdir() not available\n"; + exit 0; + } } - require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl"); + require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); plan(16); use_ok('IO::Dir'); diff --git a/ext/IO/t/io_dup.t b/ext/IO/t/io_dup.t index 8300b543d8..6afc96a272 100644 --- a/ext/IO/t/io_dup.t +++ b/ext/IO/t/io_dup.t @@ -1,12 +1,5 @@ #!./perl -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use Config; BEGIN { diff --git a/ext/IO/t/io_file.t b/ext/IO/t/io_file.t index 546c611f46..1cf60f5441 100644 --- a/ext/IO/t/io_file.t +++ b/ext/IO/t/io_file.t @@ -1,14 +1,7 @@ #!./perl -w -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use strict; -require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl"); +require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); plan(tests => ($^O =~ /MSWin32/ ? 9 : 6)); my $Class = 'IO::File'; diff --git a/ext/IO/t/io_linenum.t b/ext/IO/t/io_linenum.t index a1b1bc6e1d..259f73631a 100644 --- a/ext/IO/t/io_linenum.t +++ b/ext/IO/t/io_linenum.t @@ -7,11 +7,6 @@ my $File; BEGIN { $File = __FILE__; - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - $File =~ s/^t\W+//; # Remove first directory - @INC = '../lib'; - } require strict; import strict; } diff --git a/ext/IO/t/io_multihomed.t b/ext/IO/t/io_multihomed.t index ec1cb2bb22..f1bd5b9df9 100644 --- a/ext/IO/t/io_multihomed.t +++ b/ext/IO/t/io_multihomed.t @@ -1,12 +1,7 @@ #!./perl BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } - - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); use Config; my $can_fork = $Config{d_fork} || diff --git a/ext/IO/t/io_pipe.t b/ext/IO/t/io_pipe.t index f4519a2ffd..b7897bb2df 100644 --- a/ext/IO/t/io_pipe.t +++ b/ext/IO/t/io_pipe.t @@ -3,14 +3,7 @@ my $perl; BEGIN { - unless(grep /blib/, @INC) { - $perl = './perl'; - chdir 't' if -d 't'; - @INC = '../lib'; - } - else { - $perl = $^X; - } + $perl = $^X; } use Config; diff --git a/ext/IO/t/io_poll.t b/ext/IO/t/io_poll.t index d1c5caa19d..364d346ace 100644 --- a/ext/IO/t/io_poll.t +++ b/ext/IO/t/io_poll.t @@ -1,12 +1,5 @@ #!./perl -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - if ($^O eq 'mpeix') { print "1..0 # Skip: broken on MPE/iX\n"; exit 0; diff --git a/ext/IO/t/io_sel.t b/ext/IO/t/io_sel.t index 5d275490ec..260ca439e7 100644 --- a/ext/IO/t/io_sel.t +++ b/ext/IO/t/io_sel.t @@ -1,12 +1,5 @@ #!./perl -w -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - select(STDERR); $| = 1; select(STDOUT); $| = 1; diff --git a/ext/IO/t/io_sock.t b/ext/IO/t/io_sock.t index 24d68180c0..38aefeeb53 100644 --- a/ext/IO/t/io_sock.t +++ b/ext/IO/t/io_sock.t @@ -1,12 +1,5 @@ #!./perl -w -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use Config; BEGIN { diff --git a/ext/IO/t/io_taint.t b/ext/IO/t/io_taint.t index bcea016247..3cbe30345f 100644 --- a/ext/IO/t/io_taint.t +++ b/ext/IO/t/io_taint.t @@ -1,12 +1,5 @@ #!./perl -T -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use Config; BEGIN { @@ -18,7 +11,7 @@ BEGIN { use strict; if ($ENV{PERL_CORE}) { - require("./test.pl"); + require("../../t/test.pl"); } else { require("./t/test.pl"); diff --git a/ext/IO/t/io_tell.t b/ext/IO/t/io_tell.t index bdf225d700..7915373f08 100644 --- a/ext/IO/t/io_tell.t +++ b/ext/IO/t/io_tell.t @@ -1,14 +1,7 @@ #!./perl BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - $tell_file = "TEST"; - } - else { - $tell_file = "Makefile"; - } + $tell_file = "Makefile"; } use Config; diff --git a/ext/IO/t/io_udp.t b/ext/IO/t/io_udp.t index d89f740e3f..6b139dd83f 100644 --- a/ext/IO/t/io_udp.t +++ b/ext/IO/t/io_udp.t @@ -1,12 +1,7 @@ #!./perl BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } - - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); use Config; my $reason; diff --git a/ext/IO/t/io_unix.t b/ext/IO/t/io_unix.t index 33ee05675b..61ba3635f8 100644 --- a/ext/IO/t/io_unix.t +++ b/ext/IO/t/io_unix.t @@ -1,12 +1,5 @@ #!./perl -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use Config; BEGIN { diff --git a/ext/IO/t/io_utf8.t b/ext/IO/t/io_utf8.t index c4ba3deb1a..53c209d4b8 100644 --- a/ext/IO/t/io_utf8.t +++ b/ext/IO/t/io_utf8.t @@ -1,17 +1,13 @@ #!./perl BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } unless ($] >= 5.008 and find PerlIO::Layer 'perlio') { print "1..0 # Skip: not perlio\n"; exit 0; } } -require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl"); +require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); plan(tests => 5); diff --git a/ext/IO/t/io_xs.t b/ext/IO/t/io_xs.t index 2ef9577fc4..585eed84b2 100644 --- a/ext/IO/t/io_xs.t +++ b/ext/IO/t/io_xs.t @@ -1,12 +1,5 @@ #!./perl -BEGIN { - unless(grep /blib/, @INC) { - chdir 't' if -d 't'; - @INC = '../lib'; - } -} - use Config; BEGIN { diff --git a/ext/Math-BigInt-FastCalc/t/bigintfc.t b/ext/Math-BigInt-FastCalc/t/bigintfc.t index a89ed91461..6bace5e04c 100644 --- a/ext/Math-BigInt-FastCalc/t/bigintfc.t +++ b/ext/Math-BigInt-FastCalc/t/bigintfc.t @@ -6,7 +6,7 @@ use Test; BEGIN { $| = 1; - chdir 't' if -d 't'; + chdir 't' if -d 't' && !$ENV{PERL_CORE}; unshift @INC, '../lib'; # for running manually unshift @INC, '../blib/arch'; # for running manually plan tests => 359; diff --git a/ext/Math-BigInt-FastCalc/t/bootstrap.t b/ext/Math-BigInt-FastCalc/t/bootstrap.t index 1691dd35c1..1101966b98 100644 --- a/ext/Math-BigInt-FastCalc/t/bootstrap.t +++ b/ext/Math-BigInt-FastCalc/t/bootstrap.t @@ -7,7 +7,7 @@ BEGIN unshift @INC, '../blib/lib'; unshift @INC, '../blib/arch'; unshift @INC, '../lib'; - chdir 't' if -d 't'; + chdir 't' if -d 't' && !$ENV{PERL_CORE}; plan tests => 1; }; diff --git a/ext/Math-BigInt-FastCalc/t/leak.t b/ext/Math-BigInt-FastCalc/t/leak.t index 7de331a964..1adc831c81 100644 --- a/ext/Math-BigInt-FastCalc/t/leak.t +++ b/ext/Math-BigInt-FastCalc/t/leak.t @@ -11,7 +11,7 @@ use strict; BEGIN { $| = 1; - chdir 't' if -d 't'; + chdir 't' if -d 't' && !$ENV{PERL_CORE}; unshift @INC, ('../lib', '../blib/arch'); # for running manually plan tests => 22; } diff --git a/ext/Math-BigInt-FastCalc/t/mbi_rand.t b/ext/Math-BigInt-FastCalc/t/mbi_rand.t index 0172b25fec..52d3426f15 100644 --- a/ext/Math-BigInt-FastCalc/t/mbi_rand.t +++ b/ext/Math-BigInt-FastCalc/t/mbi_rand.t @@ -13,7 +13,7 @@ BEGIN unshift @INC, '../blib/arch'; my $location = $0; $location =~ s/mbi_rand.t//; unshift @INC, $location; # to locate the testing files - chdir 't' if -d 't'; + chdir 't' if -d 't' && !$ENV{PERL_CORE}; $count = 128; plan tests => $count*2; } diff --git a/ext/NDBM_File/t/ndbm.t b/ext/NDBM_File/t/ndbm.t index a7e49b8860..8956676491 100644 --- a/ext/NDBM_File/t/ndbm.t +++ b/ext/NDBM_File/t/ndbm.t @@ -3,8 +3,6 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bNDBM_File\b/) { print "1..0 # Skip: NDBM_File was not built\n"; diff --git a/ext/ODBM_File/t/odbm.t b/ext/ODBM_File/t/odbm.t index 7c9ffef5c2..e9706ef05c 100644 --- a/ext/ODBM_File/t/odbm.t +++ b/ext/ODBM_File/t/odbm.t @@ -3,8 +3,6 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bODBM_File\b/ or $Config{'d_cplusplus'}) { print "1..0 # Skip: ODBM_File was not built\n"; diff --git a/ext/Opcode/t/Opcode.t b/ext/Opcode/t/Opcode.t index 9f2748cc06..524fb8f6c7 100644 --- a/ext/Opcode/t/Opcode.t +++ b/ext/Opcode/t/Opcode.t @@ -3,8 +3,6 @@ $|=1; BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { print "1..0\n"; diff --git a/ext/Opcode/t/ops.t b/ext/Opcode/t/ops.t index 56b1bacabb..30edcdaa5f 100644 --- a/ext/Opcode/t/ops.t +++ b/ext/Opcode/t/ops.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { print "1..0\n"; diff --git a/ext/POSIX/t/is.t b/ext/POSIX/t/is.t index 489b3a9638..cb36fb5692 100644 --- a/ext/POSIX/t/is.t +++ b/ext/POSIX/t/is.t @@ -1,8 +1,6 @@ #!./perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) { print "1..0\n"; @@ -72,7 +70,7 @@ foreach my $s (keys %classes) { # Expected number of tests is one each for every combination of a # known is<xxx> function and string listed above. -require './test.pl'; +require '../../t/test.pl'; plan(tests => keys(%classes) * keys(%functions)); diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t index 93665325dd..0800f914b5 100644 --- a/ext/POSIX/t/posix.t +++ b/ext/POSIX/t/posix.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) { print "1..0\n"; @@ -10,7 +8,7 @@ BEGIN { } } -BEGIN { require "./test.pl"; } +BEGIN { require "../../t/test.pl"; } plan(tests => 66); use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write @@ -50,9 +48,9 @@ if ($Is_VMS) { } -ok( $testfd = open("TEST", O_RDONLY, 0), 'O_RDONLY with open' ); +ok( $testfd = open("Makefile.PL", O_RDONLY, 0), 'O_RDONLY with open' ); read($testfd, $buffer, 4) if $testfd > 2; -is( $buffer, "#!./", ' with read' ); +is( $buffer, "# Ex", ' with read' ); TODO: { @@ -147,14 +145,11 @@ SKIP: { } my $pat; -if ($Is_MacOS) { - $pat = qr/:t:$/; -} -elsif ( $unix_mode ) { - $pat = qr#[\\/]t$#i; +if ( $unix_mode ) { + $pat = qr#[\\/]POSIX$#i; } else { - $pat = qr/\.T]/i; + $pat = qr/\.POSIX]/i; } like( getcwd(), qr/$pat/, 'getcwd' ); diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t index 0d532b2472..fd6cf2de65 100644 --- a/ext/POSIX/t/sigaction.t +++ b/ext/POSIX/t/sigaction.t @@ -1,10 +1,5 @@ #!./perl -BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; -} - BEGIN{ # Don't do anything if POSIX is missing, or sigaction missing. use Config; diff --git a/ext/POSIX/t/sysconf.t b/ext/POSIX/t/sysconf.t index f11841c7fb..2dc9762977 100644 --- a/ext/POSIX/t/sysconf.t +++ b/ext/POSIX/t/sysconf.t @@ -1,11 +1,6 @@ #!perl -T BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } - use Config; use Test::More; plan skip_all => "POSIX is unavailable" if $Config{'extensions'} !~ m!\bPOSIX\b!; diff --git a/ext/POSIX/t/taint.t b/ext/POSIX/t/taint.t index a88f6561fb..3ca01743e0 100644 --- a/ext/POSIX/t/taint.t +++ b/ext/POSIX/t/taint.t @@ -1,8 +1,6 @@ #!./perl -Tw BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) { print "1..0\n"; @@ -28,7 +26,7 @@ my $testfd; my $TAINT = substr($^X, 0, 0); -my $file = 'TEST'; +my $file = 'POSIX.xs'; eval { mkfifo($TAINT. $file, 0) }; like($@, qr/^Insecure dependency/, 'mkfifo with tainted data'); @@ -40,7 +38,7 @@ eval { $testfd = open($file, O_RDONLY, 0) }; is($@, "", 'open with untainted data'); read($testfd, $buffer, 2) if $testfd > 2; -is( $buffer, "#!", ' read' ); +is( $buffer, "#d", ' read' ); ok(tainted($buffer), ' scalar tainted'); TODO: { diff --git a/ext/POSIX/t/termios.t b/ext/POSIX/t/termios.t index 2fbff9665a..7c3deb6678 100644 --- a/ext/POSIX/t/termios.t +++ b/ext/POSIX/t/termios.t @@ -1,11 +1,6 @@ #!perl -T BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } - use Config; use Test::More; plan skip_all => "POSIX is unavailable" diff --git a/ext/POSIX/t/waitpid.t b/ext/POSIX/t/waitpid.t index c36a611bfc..105b1be1b2 100644 --- a/ext/POSIX/t/waitpid.t +++ b/ext/POSIX/t/waitpid.t @@ -1,9 +1,4 @@ BEGIN { - chdir 't' if -d 't'; - unshift @INC, '../lib'; -} - -BEGIN { use Config; unless ($Config{d_fork}) { print "1..0 # Skip: no fork\n"; diff --git a/ext/PerlIO-encoding/t/fallback.t b/ext/PerlIO-encoding/t/fallback.t index 58420811a6..17ac8b1347 100644 --- a/ext/PerlIO-encoding/t/fallback.t +++ b/ext/PerlIO-encoding/t/fallback.t @@ -1,10 +1,8 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; - require "../t/test.pl"; + require "../../t/test.pl"; skip_all("No perlio") unless (find PerlIO::Layer 'perlio'); if (ord("A") == 193) { print "1..0 # Skip: EBCDIC\n"; diff --git a/ext/PerlIO-scalar/t/scalar.t b/ext/PerlIO-scalar/t/scalar.t index 393ce0d375..d2d86b5569 100644 --- a/ext/PerlIO-scalar/t/scalar.t +++ b/ext/PerlIO-scalar/t/scalar.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; unless (find PerlIO::Layer 'perlio') { print "1..0 # Skip: not perlio\n"; exit 0; diff --git a/ext/PerlIO-via/t/via.t b/ext/PerlIO-via/t/via.t index 7d46f40dc8..0619592606 100644 --- a/ext/PerlIO-via/t/via.t +++ b/ext/PerlIO-via/t/via.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; unless (find PerlIO::Layer 'perlio') { print "1..0 # Skip: not perlio\n"; exit 0; diff --git a/ext/SDBM_File/t/sdbm.t b/ext/SDBM_File/t/sdbm.t index bf138ce777..7021281ad5 100644 --- a/ext/SDBM_File/t/sdbm.t +++ b/ext/SDBM_File/t/sdbm.t @@ -3,8 +3,6 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bSDBM_File\b/) { print "1..0 # Skip: no SDBM_File\n"; diff --git a/ext/Socket/t/Socket.t b/ext/Socket/t/Socket.t index 09d25f9b95..ac50cbefc7 100644 --- a/ext/Socket/t/Socket.t +++ b/ext/Socket/t/Socket.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bSocket\b/ && !(($^O eq 'VMS') && $Config{d_socket})) { diff --git a/ext/Socket/t/socketpair.t b/ext/Socket/t/socketpair.t index 03cb5a42b7..997628c3bd 100644 --- a/ext/Socket/t/socketpair.t +++ b/ext/Socket/t/socketpair.t @@ -5,8 +5,6 @@ my $can_fork; my $has_perlio; BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; $can_fork = $Config{'d_fork'} || $Config{'d_pseudofork'}; diff --git a/ext/Sys-Hostname/t/Hostname.t b/ext/Sys-Hostname/t/Hostname.t index 85a04cd488..8e012b4d43 100644 --- a/ext/Sys-Hostname/t/Hostname.t +++ b/ext/Sys-Hostname/t/Hostname.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bSys\/Hostname\b/) { print "1..0 # Skip: Sys::Hostname was not built\n"; diff --git a/ext/Sys-Syslog/t/syslog.t b/ext/Sys-Syslog/t/syslog.t index 56a83c74ef..0b7a9c42b3 100644 --- a/ext/Sys-Syslog/t/syslog.t +++ b/ext/Sys-Syslog/t/syslog.t @@ -1,12 +1,5 @@ #!perl -T -BEGIN { - if ($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } -} - use strict; use Config; use File::Spec; diff --git a/ext/Test-Harness/t/compat/failure.t b/ext/Test-Harness/t/compat/failure.t index d199b7b67f..2f80e57884 100644 --- a/ext/Test-Harness/t/compat/failure.t +++ b/ext/Test-Harness/t/compat/failure.t @@ -19,18 +19,8 @@ use Test::Harness; return sub { $died = 1 } } - my $sample_tests; - if ( $ENV{PERL_CORE} ) { - my $updir = File::Spec->updir; - $sample_tests = File::Spec->catdir( - $updir, 'ext', 'Test-Harness', 't', - 'sample-tests' - ); - } - else { - my $curdir = File::Spec->curdir; - $sample_tests = File::Spec->catdir( $curdir, 't', 'sample-tests' ); - } + my $curdir = File::Spec->curdir; + my $sample_tests = File::Spec->catdir( $curdir, 't', 'sample-tests' ); { local $SIG{__DIE__} = prepare_for_death(); diff --git a/ext/Test-Harness/t/compat/inc_taint.t b/ext/Test-Harness/t/compat/inc_taint.t index b0917dbb99..3bd86b4108 100644 --- a/ext/Test-Harness/t/compat/inc_taint.t +++ b/ext/Test-Harness/t/compat/inc_taint.t @@ -1,14 +1,6 @@ #!/usr/bin/perl -w -BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - use lib 't/lib'; - } -} +use lib 't/lib'; use strict; @@ -33,11 +25,7 @@ sub _all_ok { tie *NULL, 'Dev::Null' or die $!; select NULL; my ( $tot, $failed ) = Test::Harness::execute_tests( - tests => [ - $ENV{PERL_CORE} - ? '../ext/Test-Harness/t/sample-tests/inc_taint' - : 't/sample-tests/inc_taint' - ] + tests => ['t/sample-tests/inc_taint'] ); select STDOUT; diff --git a/ext/Test-Harness/t/compat/test-harness-compat.t b/ext/Test-Harness/t/compat/test-harness-compat.t index 0009df16f8..cae9a54333 100644 --- a/ext/Test-Harness/t/compat/test-harness-compat.t +++ b/ext/Test-Harness/t/compat/test-harness-compat.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -21,8 +15,7 @@ use Test::Harness qw(execute_tests); # unset this global when self-testing ('testcover' and etc issue) local $ENV{HARNESS_PERL_SWITCHES}; -my $TEST_DIR - = $ENV{PERL_CORE} ? '../ext/Test-Harness/t/sample-tests' : 't/sample-tests'; +my $TEST_DIR = 't/sample-tests'; { diff --git a/ext/Test-Harness/t/file.t b/ext/Test-Harness/t/file.t index 40793c3d42..f97d1aadd0 100644 --- a/ext/Test-Harness/t/file.t +++ b/ext/Test-Harness/t/file.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -18,10 +12,8 @@ use TAP::Harness; my $HARNESS = 'TAP::Harness'; -my $source_tests - = $ENV{PERL_CORE} ? '../ext/Test-Harness/t/source_tests' : 't/source_tests'; -my $sample_tests - = $ENV{PERL_CORE} ? '../ext/Test-Harness/t/sample-tests' : 't/sample-tests'; +my $source_tests = 't/source_tests'; +my $sample_tests = 't/sample-tests'; plan tests => 56; diff --git a/ext/Test-Harness/t/grammar.t b/ext/Test-Harness/t/grammar.t index 206fabef89..b74fc8ba65 100644 --- a/ext/Test-Harness/t/grammar.t +++ b/ext/Test-Harness/t/grammar.t @@ -3,13 +3,7 @@ use strict; BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use Test::More tests => 94; diff --git a/ext/Test-Harness/t/harness-bailout.t b/ext/Test-Harness/t/harness-bailout.t index 0ee8a793d6..fd1dc35669 100644 --- a/ext/Test-Harness/t/harness-bailout.t +++ b/ext/Test-Harness/t/harness-bailout.t @@ -35,10 +35,6 @@ for my $test (@jobs) { $harness->runtests( File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir, 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests', 'bailout' diff --git a/ext/Test-Harness/t/harness-subclass.t b/ext/Test-Harness/t/harness-subclass.t index c7d30c88e7..c6b46daa21 100644 --- a/ext/Test-Harness/t/harness-subclass.t +++ b/ext/Test-Harness/t/harness-subclass.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -53,10 +47,6 @@ for my $class ( values %class_map ) { my $aggregate = $harness->runtests( File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir, 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests', 'simple' diff --git a/ext/Test-Harness/t/harness.t b/ext/Test-Harness/t/harness.t index 3a6dc03023..3643f576f3 100644 --- a/ext/Test-Harness/t/harness.t +++ b/ext/Test-Harness/t/harness.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -19,10 +13,8 @@ use TAP::Harness; my $HARNESS = 'TAP::Harness'; -my $source_tests - = $ENV{PERL_CORE} ? '../ext/Test-Harness/t/source_tests' : 't/source_tests'; -my $sample_tests - = $ENV{PERL_CORE} ? '../ext/Test-Harness/t/sample-tests' : 't/sample-tests'; +my $source_tests = 't/source_tests'; +my $sample_tests = 't/sample-tests'; plan tests => 119; @@ -543,9 +535,7 @@ SKIP: { eval { _runtests( $harness, - $ENV{PERL_CORE} - ? '../ext/Test-Harness/t/data/catme.1' - : 't/data/catme.1' + 't/data/catme.1' ); }; @@ -593,9 +583,7 @@ SKIP: { exec => sub { return [ $cat, - $ENV{PERL_CORE} - ? '../ext/Test-Harness/t/data/catme.1' - : 't/data/catme.1' + 't/data/catme.1' ]; }, } @@ -642,10 +630,7 @@ SKIP: { { verbosity => -2, stdout => $capture, exec => sub { - open my $fh, - $ENV{PERL_CORE} - ? '../ext/Test-Harness/t/data/catme.1' - : 't/data/catme.1'; + open my $fh, 't/data/catme.1'; return $fh; }, } @@ -916,10 +901,6 @@ sub _runtests { # coverage tests for the basically untested T::H::_open_spool my @spool = ( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), ( 't', 'spool' ) ); $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(@spool); diff --git a/ext/Test-Harness/t/iterators.t b/ext/Test-Harness/t/iterators.t index c82387bd7c..d190be9289 100644 --- a/ext/Test-Harness/t/iterators.t +++ b/ext/Test-Harness/t/iterators.t @@ -42,10 +42,6 @@ my @schedule = ( command => [ $^X, File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests', 'out_err_mix' diff --git a/ext/Test-Harness/t/multiplexer.t b/ext/Test-Harness/t/multiplexer.t index 3598521bdf..649d5d161f 100644 --- a/ext/Test-Harness/t/multiplexer.t +++ b/ext/Test-Harness/t/multiplexer.t @@ -56,11 +56,6 @@ my @schedule = ( return [ TAP::Parser->new( { source => File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' - ) - : () - ), 't', 'sample-tests', 'simple' @@ -82,12 +77,6 @@ my @schedule = ( return map { [ TAP::Parser->new( { source => File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', - 'Test-Harness' - ) - : () - ), 't', 'sample-tests', 'simple' @@ -129,12 +118,6 @@ my @schedule = ( ( map { [ TAP::Parser->new( { source => File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', - 'Test-Harness' - ) - : () - ), 't', 'sample-tests', 'simple' diff --git a/ext/Test-Harness/t/nofork-mux.t b/ext/Test-Harness/t/nofork-mux.t index 1dba20d470..4f28bf8c1d 100644 --- a/ext/Test-Harness/t/nofork-mux.t +++ b/ext/Test-Harness/t/nofork-mux.t @@ -1,17 +1,10 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - use lib 't/lib'; - } + use lib 't/lib'; } use strict; use NoFork; -require( - ( $ENV{PERL_CORE} ? '../ext/Test-Harness/' : '' ) . 't/multiplexer.t' ); +require( 't/multiplexer.t' ); diff --git a/ext/Test-Harness/t/nofork.t b/ext/Test-Harness/t/nofork.t index 01375e034b..1d8b340e1b 100644 --- a/ext/Test-Harness/t/nofork.t +++ b/ext/Test-Harness/t/nofork.t @@ -3,15 +3,7 @@ # check nofork logic on systems which *can* fork() # NOTE maybe a good candidate for xt/author or something. -BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - use lib 't/lib'; - } -} +use lib 't/lib'; use strict; @@ -57,8 +49,7 @@ my $mod = 'TAP::Parser::Iterator::Process'; stdout => $capture, } ); - $harness->runtests( ( $ENV{PERL_CORE} ? '../ext/Test-Harness/' : '' ) - . 't/sample-tests/simple' ); + $harness->runtests( 't/sample-tests/simple' ); my @output = tied($$capture)->dump; is pop @output, "Result: PASS\n", 'status OK'; pop @output; # get rid of summary line diff --git a/ext/Test-Harness/t/parse.t b/ext/Test-Harness/t/parse.t index 942c1786d1..f0def28c9a 100644 --- a/ext/Test-Harness/t/parse.t +++ b/ext/Test-Harness/t/parse.t @@ -2,15 +2,7 @@ use strict; -BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - use lib 't/lib'; - } -} +use lib 't/lib'; use Test::More tests => 294; use IO::c55Capture; @@ -454,9 +446,7 @@ is( scalar @results, 2, "Got two lines of TAP" ); # Check source => $filehandle can_ok $PARSER, 'new'; -open my $fh, $ENV{PERL_CORE} - ? '../ext/Test-Harness/t/data/catme.1' - : 't/data/catme.1'; +open my $fh, 't/data/catme.1'; $parser = $PARSER->new( { source => $fh } ); isa_ok $parser, $PARSER, '... and calling it should succeed'; ok @results = _get_results($parser), 'The parser should return results'; @@ -629,10 +619,6 @@ END_TAP my $parser = TAP::Parser->new( { source => File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests', 'simple' diff --git a/ext/Test-Harness/t/parser-config.t b/ext/Test-Harness/t/parser-config.t index 9ae068e2bc..bd3625902d 100644 --- a/ext/Test-Harness/t/parser-config.t +++ b/ext/Test-Harness/t/parser-config.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { unshift @INC, 't/lib'; - } } use strict; @@ -23,8 +17,7 @@ use_ok('MyGrammar'); use_ok('MyIteratorFactory'); use_ok('MyResultFactory'); -my @t_path = $ENV{PERL_CORE} ? ( updir(), 'ext', 'Test-Harness' ) : (); -my $source = catfile( @t_path, 't', 'source_tests', 'source' ); +my $source = catfile( 't', 'source_tests', 'source' ); my %customize = ( source_class => 'MySource', perl_source_class => 'MyPerlSource', diff --git a/ext/Test-Harness/t/parser-subclass.t b/ext/Test-Harness/t/parser-subclass.t index e5dc797611..303c28ca27 100644 --- a/ext/Test-Harness/t/parser-subclass.t +++ b/ext/Test-Harness/t/parser-subclass.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -19,11 +13,9 @@ use File::Spec::Functions qw( catfile updir ); use_ok('TAP::Parser::SubclassTest'); # TODO: foreach my $source ( ... ) -my @t_path = $ENV{PERL_CORE} ? ( updir(), 'ext', 'Test-Harness' ) : (); - { # perl source %INIT = %CUSTOM = (); - my $source = catfile( @t_path, 't', 'subclass_tests', 'perl_source' ); + my $source = catfile( 't', 'subclass_tests', 'perl_source' ); my $p = TAP::Parser::SubclassTest->new( { source => $source } ); # The grammar is lazily constructed so we need to ask for it to @@ -78,7 +70,7 @@ SKIP: { # non-perl source unless ( -e $cat ) { skip "no '$cat'", 4; } - my $file = catfile( @t_path, 't', 'data', 'catme.1' ); + my $file = catfile( 't', 'data', 'catme.1' ); my $p = TAP::Parser::SubclassTest->new( { exec => [ $cat => $file ] } ); is( $INIT{MySource}, 1, 'initialized MySource subclass' ); diff --git a/ext/Test-Harness/t/process.t b/ext/Test-Harness/t/process.t index 63a8620dfc..5135d67f95 100644 --- a/ext/Test-Harness/t/process.t +++ b/ext/Test-Harness/t/process.t @@ -28,10 +28,6 @@ my @expect = ( ); my $source = File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests', 'delayed' diff --git a/ext/Test-Harness/t/prove.t b/ext/Test-Harness/t/prove.t index d6ca95f7d2..71730cdbf6 100644 --- a/ext/Test-Harness/t/prove.t +++ b/ext/Test-Harness/t/prove.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -1014,7 +1008,7 @@ BEGIN { # START PLAN args => { argv => [qw( one two three )], }, - proverc => $ENV{PERL_CORE} ? '../ext/Test-Harness/t/proverc/emptyexec' : 't/proverc/emptyexec', + proverc => 't/proverc/emptyexec', switches => [$dummy_test], expect => { exec => '' }, runlog => [ diff --git a/ext/Test-Harness/t/proverc.t b/ext/Test-Harness/t/proverc.t index 5a7d97e161..37d6de803b 100644 --- a/ext/Test-Harness/t/proverc.t +++ b/ext/Test-Harness/t/proverc.t @@ -1,15 +1,5 @@ #!/usr/bin/perl -w -BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', 'lib' ); - } - else { - unshift @INC, 't/lib'; - } -} - use strict; use lib 't/lib'; use Test::More tests => 1; @@ -20,10 +10,6 @@ my $prove = App::Prove->new; $prove->add_rc_file( File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'data', 'proverc' ) diff --git a/ext/Test-Harness/t/proverun.t b/ext/Test-Harness/t/proverun.t index 0971684535..6e6c2f33f5 100644 --- a/ext/Test-Harness/t/proverun.t +++ b/ext/Test-Harness/t/proverun.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', 'lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -34,10 +28,6 @@ BEGIN { # let's fully expand that filename $test->{file} = File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests', $test->{file} diff --git a/ext/Test-Harness/t/regression.t b/ext/Test-Harness/t/regression.t index b86dd07233..20879ca2b6 100644 --- a/ext/Test-Harness/t/regression.t +++ b/ext/Test-Harness/t/regression.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } - else { - push @INC, 't/lib'; - } + push @INC, 't/lib'; } use strict; @@ -30,10 +24,6 @@ my $IsWin32 = $^O eq 'MSWin32'; my $SAMPLE_TESTS = File::Spec->catdir( File::Spec->curdir, - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests' ); diff --git a/ext/Test-Harness/t/sample-tests/delayed b/ext/Test-Harness/t/sample-tests/delayed index f016a69348..1f24ef6790 100644 --- a/ext/Test-Harness/t/sample-tests/delayed +++ b/ext/Test-Harness/t/sample-tests/delayed @@ -1,10 +1,4 @@ # Used to test Process.pm -BEGIN { - if ( $ENV{PERL_CORE} ) { - @INC = '../lib'; - } -} - use Time::HiRes qw(sleep); my $delay = 0.01; diff --git a/ext/Test-Harness/t/source.t b/ext/Test-Harness/t/source.t index 09acb0afb0..ce9063e57b 100644 --- a/ext/Test-Harness/t/source.t +++ b/ext/Test-Harness/t/source.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', '../ext/Test-Harness/t/lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -22,10 +16,6 @@ use TAP::Parser::Source::Perl; my $parser = EmptyParser->new; my $test = File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'source_tests', 'source' diff --git a/ext/Test-Harness/t/source_tests/source b/ext/Test-Harness/t/source_tests/source index 6d469f4581..be28995e63 100644 --- a/ext/Test-Harness/t/source_tests/source +++ b/ext/Test-Harness/t/source_tests/source @@ -2,8 +2,7 @@ BEGIN { if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', 'lib' ); + @INC = ( '../../lib', 't/lib' ); } else { unshift @INC, 't/lib'; diff --git a/ext/Test-Harness/t/spool.t b/ext/Test-Harness/t/spool.t index deb1a0205f..d22ffcdd77 100644 --- a/ext/Test-Harness/t/spool.t +++ b/ext/Test-Harness/t/spool.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', 'lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } # test T::H::_open_spool and _close_spool - these are good examples @@ -66,7 +60,7 @@ plan tests => 4; # coverage tests for the basically untested T::H::_open_spool - my @spool = ( $ENV{PERL_CORE} ? ('spool') : ( 't', 'spool' ) ); + my @spool = ( 't', 'spool' ); $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(@spool); # now given that we're going to be writing stuff to the file system, make sure we have diff --git a/ext/Test-Harness/t/state.t b/ext/Test-Harness/t/state.t index 723b88e4ad..52e99e37c1 100644 --- a/ext/Test-Harness/t/state.t +++ b/ext/Test-Harness/t/state.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; @@ -16,8 +10,8 @@ use App::Prove::State; use App::Prove::State::Result; sub mn { - my $pfx = $ENV{PERL_CORE} ? '../ext/Test-Harness/' : ''; - return map {"$pfx$_"} @_; + # FIXME - remove this. + return @_; } my @schedule = ( diff --git a/ext/Test-Harness/t/state_results.t b/ext/Test-Harness/t/state_results.t index db532c91c1..fe0b944333 100644 --- a/ext/Test-Harness/t/state_results.t +++ b/ext/Test-Harness/t/state_results.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } use strict; diff --git a/ext/Test-Harness/t/taint.t b/ext/Test-Harness/t/taint.t index 80acec8fb1..2812fc4375 100644 --- a/ext/Test-Harness/t/taint.t +++ b/ext/Test-Harness/t/taint.t @@ -1,13 +1,7 @@ #!/usr/bin/perl -w BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ( '../lib', 'lib' ); - } - else { - unshift @INC, 't/lib'; - } + unshift @INC, 't/lib'; } # Test that options in PERL5OPT are propogated to tainted tests @@ -43,7 +37,7 @@ sub run_test_file { } { - local $ENV{PERL5OPT} = $ENV{PERL_CORE} ? '-I../lib -Mstrict' : '-Mstrict'; + local $ENV{PERL5OPT} = $ENV{PERL_CORE} ? '-I../../lib -Mstrict' : '-Mstrict'; run_test_file(<<'END'); #!/usr/bin/perl -T diff --git a/ext/Test-Harness/t/testargs.t b/ext/Test-Harness/t/testargs.t index ae9e327b95..aa3aa7337c 100644 --- a/ext/Test-Harness/t/testargs.t +++ b/ext/Test-Harness/t/testargs.t @@ -1,9 +1,5 @@ #!/usr/bin/perl -w -BEGIN { - chdir 't' and @INC = '../lib' if $ENV{PERL_CORE}; -} - use strict; use lib 't/lib'; @@ -14,10 +10,6 @@ use TAP::Harness; use App::Prove; my $test = File::Spec->catfile( - ( $ENV{PERL_CORE} - ? ( File::Spec->updir(), 'ext', 'Test-Harness' ) - : () - ), 't', 'sample-tests', 'echo' diff --git a/ext/Test-Harness/t/utils.t b/ext/Test-Harness/t/utils.t index d60c8a2939..4851ac1f1c 100644 --- a/ext/Test-Harness/t/utils.t +++ b/ext/Test-Harness/t/utils.t @@ -1,9 +1,5 @@ #!/usr/bin/perl -w -BEGIN { - chdir 't' and @INC = '../lib' if $ENV{PERL_CORE}; -} - use strict; use lib 't/lib'; diff --git a/ext/Text-Soundex/t/Soundex.t b/ext/Text-Soundex/t/Soundex.t index d35f264c7a..a48fb4abe0 100644 --- a/ext/Text-Soundex/t/Soundex.t +++ b/ext/Text-Soundex/t/Soundex.t @@ -16,11 +16,6 @@ # # -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - use Text::Soundex; $test = 0; diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t index f06ae88507..e7c1545b5e 100644 --- a/ext/XS-APItest/t/call.t +++ b/ext/XS-APItest/t/call.t @@ -4,8 +4,6 @@ # DAPM Aug 2004 BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { @@ -23,7 +21,7 @@ use strict; # use Test::More tests => 240; BEGIN { - require './test.pl'; + require '../../t/test.pl'; plan(240); use_ok('XS::APItest') }; @@ -160,7 +158,7 @@ is($@, "its_dead_jim\n", "eval { eval_pv('d()', 1) } - \$@"); # a new jump level but before pushing an eval context, leading to # stack corruption -fresh_perl_is(<<'EOF', "x=2", { switches => ['-T'] }, 'eval_sv() taint'); +fresh_perl_is(<<'EOF', "x=2", { switches => ['-T', '-I../../lib'] }, 'eval_sv() taint'); use XS::APItest; my $x = 0; diff --git a/ext/XS-APItest/t/exception.t b/ext/XS-APItest/t/exception.t index 2ac7132b63..20d5d163c4 100644 --- a/ext/XS-APItest/t/exception.t +++ b/ext/XS-APItest/t/exception.t @@ -1,6 +1,4 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/hash.t b/ext/XS-APItest/t/hash.t index c7581b2036..e710bc2542 100644 --- a/ext/XS-APItest/t/hash.t +++ b/ext/XS-APItest/t/hash.t @@ -1,8 +1,6 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/my_cxt.t b/ext/XS-APItest/t/my_cxt.t index beda2d24a0..2513518eef 100644 --- a/ext/XS-APItest/t/my_cxt.t +++ b/ext/XS-APItest/t/my_cxt.t @@ -5,8 +5,6 @@ my $threads; BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/op.t b/ext/XS-APItest/t/op.t index f541888483..1c3d970363 100644 --- a/ext/XS-APItest/t/op.t +++ b/ext/XS-APItest/t/op.t @@ -1,8 +1,6 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { @@ -26,4 +24,4 @@ use_ok('XS::APItest'); *hint_exists = *hint_exists = \&XS::APItest::Hash::refcounted_he_exists; *hint_fetch = *hint_fetch = \&XS::APItest::Hash::refcounted_he_fetch; -require './op/caller.pl'; +require '../../t/op/caller.pl'; diff --git a/ext/XS-APItest/t/printf.t b/ext/XS-APItest/t/printf.t index ef2769e8fa..23741890d5 100644 --- a/ext/XS-APItest/t/printf.t +++ b/ext/XS-APItest/t/printf.t @@ -1,6 +1,4 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/push.t b/ext/XS-APItest/t/push.t index 66d442e385..b50c429fe9 100644 --- a/ext/XS-APItest/t/push.t +++ b/ext/XS-APItest/t/push.t @@ -1,6 +1,4 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/svpeek.t b/ext/XS-APItest/t/svpeek.t index 822638648e..824c0c8d78 100644 --- a/ext/XS-APItest/t/svpeek.t +++ b/ext/XS-APItest/t/svpeek.t @@ -1,6 +1,4 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/svsetsv.t b/ext/XS-APItest/t/svsetsv.t index dcf388ab70..bde39e56ea 100644 --- a/ext/XS-APItest/t/svsetsv.t +++ b/ext/XS-APItest/t/svsetsv.t @@ -1,6 +1,4 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/xs_special_subs.t b/ext/XS-APItest/t/xs_special_subs.t index 13b0461dd8..90f54dccc6 100644 --- a/ext/XS-APItest/t/xs_special_subs.t +++ b/ext/XS-APItest/t/xs_special_subs.t @@ -1,8 +1,6 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-APItest/t/xs_special_subs_require.t b/ext/XS-APItest/t/xs_special_subs_require.t index af957be1e2..55b69481b3 100644 --- a/ext/XS-APItest/t/xs_special_subs_require.t +++ b/ext/XS-APItest/t/xs_special_subs_require.t @@ -1,7 +1,5 @@ #!perl -w BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/APItest\b/) { diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t index accb6c40d4..1eed620e43 100644 --- a/ext/XS-Typemap/t/Typemap.t +++ b/ext/XS-Typemap/t/Typemap.t @@ -1,6 +1,4 @@ BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bXS\/Typemap\b/) { print "1..0 # Skip: XS::Typemap was not built\n"; diff --git a/ext/re/t/lexical_debug.t b/ext/re/t/lexical_debug.t index 3c3f7ba316..d4b7e62910 100644 --- a/ext/re/t/lexical_debug.t +++ b/ext/re/t/lexical_debug.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; if (($Config::Config{'extensions'} !~ /\bre\b/) ){ print "1..0 # Skip -- Perl configured without re module\n"; @@ -14,8 +12,8 @@ use strict; # must use a BEGIN or the prototypes wont be respected meaning # tests could pass that shouldn't -BEGIN { require "./test.pl"; } -my $out = runperl(progfile => "../ext/re/t/lexical_debug.pl", stderr => 1 ); +BEGIN { require "../../t/test.pl"; } +my $out = runperl(progfile => "t/lexical_debug.pl", stderr => 1 ); print "1..10\n"; diff --git a/ext/re/t/qr.t b/ext/re/t/qr.t index 9a59a046bd..cf51cbd8b1 100644 --- a/ext/re/t/qr.t +++ b/ext/re/t/qr.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; if (($Config::Config{'extensions'} !~ /\bre\b/) ){ print "1..0 # Skip -- Perl configured without re module\n"; diff --git a/ext/re/t/re.t b/ext/re/t/re.t index 204092f028..8e06ef5172 100644 --- a/ext/re/t/re.t +++ b/ext/re/t/re.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; if (($Config::Config{'extensions'} !~ /\bre\b/) ){ print "1..0 # Skip -- Perl configured without re module\n"; diff --git a/ext/re/t/re_funcs.t b/ext/re/t/re_funcs.t index e618171996..69275d898d 100644 --- a/ext/re/t/re_funcs.t +++ b/ext/re/t/re_funcs.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; if (($Config::Config{'extensions'} !~ /\bre\b/) ){ print "1..0 # Skip -- Perl configured without re module\n"; diff --git a/ext/re/t/regop.t b/ext/re/t/regop.t index 7fe7b20462..9118bf6203 100644 --- a/ext/re/t/regop.t +++ b/ext/re/t/regop.t @@ -1,8 +1,6 @@ #!./perl BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; require Config; if (($Config::Config{'extensions'} !~ /\bre\b/) ){ print "1..0 # Skip -- Perl configured without re module\n"; @@ -11,10 +9,10 @@ BEGIN { } use strict; -BEGIN { require "./test.pl"; } +BEGIN { require "../../t/test.pl"; } our $NUM_SECTS; chomp(my @strs= grep { !/^\s*\#/ } <DATA>); -my $out = runperl(progfile => "../ext/re/t/regop.pl", stderr => 1 ); +my $out = runperl(progfile => "t/regop.pl", stderr => 1 ); # VMS currently embeds linefeeds in the output. $out =~ s/\cJ//g if $^O = 'VMS'; my @tests = grep { /\S/ } split /(?=Compiling REx)/, $out; @@ -258,4 +256,4 @@ Got 100 bytes for offset annotations. Offsets: [12] 1:1[3] 3:4[0] %MATCHED% -Freeing REx: "[q]"
\ No newline at end of file +Freeing REx: "[q]" diff --git a/ext/threads-shared/t/wait.t b/ext/threads-shared/t/wait.t index 2c367fd075..0f815d6f66 100644 --- a/ext/threads-shared/t/wait.t +++ b/ext/threads-shared/t/wait.t @@ -5,7 +5,7 @@ BEGIN { # Import test.pl into its own package { package Test; - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); } use Config; diff --git a/ext/threads-shared/t/waithires.t b/ext/threads-shared/t/waithires.t index ae82448f57..e3a1086370 100644 --- a/ext/threads-shared/t/waithires.t +++ b/ext/threads-shared/t/waithires.t @@ -5,7 +5,7 @@ BEGIN { # Import test.pl into its own package { package Test; - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); } use Config; diff --git a/ext/threads/t/err.t b/ext/threads/t/err.t index 9888ee0987..f5e0a19f82 100644 --- a/ext/threads/t/err.t +++ b/ext/threads/t/err.t @@ -2,7 +2,7 @@ use strict; use warnings; BEGIN { - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); use Config; if (! $Config{'useithreads'}) { diff --git a/ext/threads/t/exit.t b/ext/threads/t/exit.t index 7e42172d10..34f248a4db 100644 --- a/ext/threads/t/exit.t +++ b/ext/threads/t/exit.t @@ -2,7 +2,7 @@ use strict; use warnings; BEGIN { - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); use Config; if (! $Config{'useithreads'}) { diff --git a/ext/threads/t/free.t b/ext/threads/t/free.t index b6bec81219..d41199af05 100644 --- a/ext/threads/t/free.t +++ b/ext/threads/t/free.t @@ -5,7 +5,7 @@ BEGIN { # Import test.pl into its own package { package Test; - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); } use Config; diff --git a/ext/threads/t/free2.t b/ext/threads/t/free2.t index 2e0bbf01ab..99761302c6 100644 --- a/ext/threads/t/free2.t +++ b/ext/threads/t/free2.t @@ -5,7 +5,7 @@ BEGIN { # Import test.pl into its own package { package Test; - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); } use Config; diff --git a/ext/threads/t/libc.t b/ext/threads/t/libc.t index 9741cce09d..4f6f6ed3ae 100644 --- a/ext/threads/t/libc.t +++ b/ext/threads/t/libc.t @@ -2,7 +2,7 @@ use strict; use warnings; BEGIN { - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); use Config; if (! $Config{'useithreads'}) { diff --git a/ext/threads/t/thread.t b/ext/threads/t/thread.t index a5df4f7f55..b980c625c0 100644 --- a/ext/threads/t/thread.t +++ b/ext/threads/t/thread.t @@ -2,7 +2,7 @@ use strict; use warnings; BEGIN { - require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl'); + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); use Config; if (! $Config{'useithreads'}) { @@ -14,6 +14,39 @@ # In which case, we need to stop t/TEST actually running tests, as all # t/harness needs are its subroutines. + +# directories with special sets of test switches +my %dir_to_switch = + (base => '', + comp => '', + run => '', + '../ext/File-Glob/t' => '-I. -MTestInit', # FIXME - tests assume t/ + ); + +my %temp_no_core = + ('../ext/Attribute-Handlers' => 1, + '../ext/B' => 'fixme', + '../ext/Compress-Raw-Bzip2' => 1, + '../ext/Compress-Raw-Zlib' => 1, + '../ext/Data-Dumper' => 'fixme', + '../ext/Devel-PPPort' => 1, + '../ext/DynaLoader' => 'fixme', + '../ext/Encode' => 1, + '../ext/Hash-Util' => 'fixme', + '../ext/Hash-Util-FieldHash' => 'fixme', + '../ext/I18N-Langinfo' => 'fixme', + '../ext/IO-Compress' => 1, + '../ext/IPC-SysV' => 1, + '../ext/MIME-Base64' => 1, + '../ext/Safe' => 'fixme', + '../ext/Storable' => 'fixme', + '../ext/Time-HiRes' => 1, + '../ext/Unicode-Normalize' => 1, + ); + +# Fix Text-Soundex +# Fix Win32 + if ($::do_nothing) { return 1; } @@ -141,14 +174,7 @@ sub _scan_test { return { file => $file_opts, switch => $switch }; } - -# directories with special sets of test switches -my %dir_to_switch = - (base => '', - comp => '', - run => '', - ); - + sub _run_test { my($harness, $test, $type) = @_; if (!defined $type) { @@ -157,14 +183,29 @@ sub _run_test { } my $options = _scan_test($test, $type); + my $return_dir; my $perl = './perl'; my $lib = '../lib'; - $test =~ /^([^\/]+)/; + $test =~ /^(.+)\/[^\/]+/; + my $dir = $1; + my $ext_dir; - my $testswitch = $dir_to_switch{$1}; + my $testswitch = $dir_to_switch{$dir}; if (!defined $testswitch) { - $testswitch = '-I. -MTestInit'; # -T will remove . from @INC + if ($test =~ s!^(\.\./ext/[^/]+)/t!t!) { + $ext_dir = $1; + $return_dir = '../../t'; + $lib = '../../lib'; + $perl = '../../perl'; + $testswitch = "-I$return_dir -MTestInit=U2T,A"; + if ($temp_no_core{$ext_dir}) { + $testswitch = $testswitch . ',NC'; + } + chdir $ext_dir or die "Can't chdir to '$ext_dir': $!"; + } else { + $testswitch = '-I. -MTestInit'; # -T will remove . from @INC + } } my $utf8 = $::with_utf8 ? '-I$lib -Mutf8' : ''; @@ -180,7 +221,6 @@ sub _run_test { or print "can't deparse '$deparse_cmd': $!.\n"; } elsif ($type eq 'perl') { - my $perl = $ENV{PERL} || $perl; my $redir = $^O eq 'VMS' ? '2>&1' : ''; if ($ENV{PERL_VALGRIND}) { @@ -198,6 +238,11 @@ sub _run_test { open($results, $run) or print "can't run '$run': $!.\n"; } + if ($return_dir) { + chdir $return_dir + or die "Can't chdir from '$ext_dir' to '$return_dir': $!"; + } + # Our environment may force us to use UTF-8, but we can't be sure that # anything we're reading from will be generating (well formed) UTF-8 # This may not be the best way - possibly we should unset ${^OPEN} up diff --git a/t/TestInit.pm b/t/TestInit.pm index 637cfec105..31faebb8a5 100644 --- a/t/TestInit.pm +++ b/t/TestInit.pm @@ -20,6 +20,7 @@ package TestInit; $VERSION = 1.02; +# This is incompatible with the import options. chdir 't' if -f 't/TestInit.pm'; # Let tests know they're running in the perl core. Useful for modules @@ -28,10 +29,66 @@ chdir 't' if -f 't/TestInit.pm'; # This feels like a better solution than the original, from # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2003-07/msg00154.html $ENV{PERL_CORE} = $^X; -if (${^TAINT}) { - @INC = '../lib'; -} else { - @INC = ('../lib', '.'); + +sub new_inc { + if (${^TAINT}) { + @INC = @_; + } else { + @INC = (@_, '.'); + } +} + +sub set_opt { + my $sep; + if ($^O eq 'VMS') { + $sep = '|'; + } elsif ($^O eq 'Win32') { + $sep = ';'; + } else { + $sep = ':'; + } + + my $lib = join $sep, @_; + if (exists $ENV{PERL5LIB}) { + $ENV{PERL5LIB} = $lib . substr $ENV{PERL5LIB}, 0, 0; + } else { + $ENV{PERL5LIB} = $lib; + } +} + +new_inc('../lib'); + +sub import { + my $self = shift; + my $abs; + foreach (@_) { + if ($_ eq 'U2T') { + @new_inc = ('../../lib', '../../t'); + } elsif ($_ eq 'NC') { + delete $ENV{PERL_CORE} + } elsif ($_ eq 'A') { + $abs = 1; + } else { + die "Unknown option '$_'"; + } + } + + if ($abs) { + if(!@new_inc) { + @new_inc = '../lib'; + } + @INC = @new_inc; + require File::Spec::Functions; + # Forcibly untaint this. + @new_inc = map { $_ = File::Spec::Functions::rel2abs($_); /(.*)/; $1 } + @new_inc; + $^X = File::Spec::Functions::rel2abs($^X); + } + + if (@new_inc) { + new_inc(@new_inc); + set_opt(@new_inc); + } } $0 =~ s/\.dp$//; # for the test.deparse make target |