2 if( $ENV{PERL_CORE} ) {
3 chdir '../lib/Archive/Tar' if -d '../lib/Archive/Tar';
8 BEGIN { chdir 't' if -d 't' }
17 ### developer tests mostly, so enable them with an extra argument
18 plan skip_all => "Skipping tests on this platform" unless @ARGV;
21 my $Class = 'Archive::Tar';
22 my $Dir = File::Spec->catdir( qw[src linktest] );
24 File::Spec->catfile( $Dir, "linktest_with_dir.tar" ) => [
25 [ 0, qr/SECURE EXTRACT MODE/ ],
28 File::Spec->catfile( $Dir, "linktest_missing_dir.tar" ) => [
29 [ 0, qr/SECURE EXTRACT MODE/ ],
30 [ 0, qr/File exists/ ],
36 { while( my($file, $aref) = each %Map ) {
38 for my $mode ( 0, 1 ) {
39 my $expect = $aref->[$mode]->[0];
40 my $regex = $aref->[$mode]->[1];
42 my $tar = $Class->new( $file );
43 ok( $tar, "Object created from $file" );
46 local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
47 local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode;
49 ok( 1, " Extracting with insecure mode: $mode" );
52 local $SIG{__WARN__} = sub { $warning .= "@_"; warn @_; };
54 my $rv = eval { $tar->extract } || 0;
55 ok( !$@, " No fatal error" );
56 is( !!$rv, !!$expect, " RV as expected" );
57 like( $warning, $regex, " Error matches $regex" );