1BEGIN { chdir 't' if -d 't' } 2 3use lib '../lib'; 4 5use strict; 6use File::Spec; 7use File::Path; 8use Test::More; 9 10### developer tests mostly, so enable them with an extra argument 11plan skip_all => "Skipping tests on this platform" unless @ARGV; 12plan 'no_plan'; 13 14my $Class = 'Archive::Tar'; 15my $Dir = File::Spec->catdir( qw[src linktest] ); 16my %Map = ( 17 File::Spec->catfile( $Dir, "linktest_with_dir.tar" ) => [ 18 [ 0, qr/SECURE EXTRACT MODE/ ], 19 [ 1, qr/^$/ ] 20 ], 21 File::Spec->catfile( $Dir, "linktest_missing_dir.tar" ) => [ 22 [ 0, qr/SECURE EXTRACT MODE/ ], 23 [ 0, qr/File exists/ ], 24 ], 25); 26 27use_ok( $Class ); 28 29{ while( my($file, $aref) = each %Map ) { 30 31 for my $mode ( 0, 1 ) { 32 my $expect = $aref->[$mode]->[0]; 33 my $regex = $aref->[$mode]->[1]; 34 35 my $tar = $Class->new( $file ); 36 ok( $tar, "Object created from $file" ); 37 38 ### damn warnings 39 local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode; 40 local $Archive::Tar::INSECURE_EXTRACT_MODE = $mode; 41 42 ok( 1, " Extracting with insecure mode: $mode" ); 43 44 my $warning; 45 local $SIG{__WARN__} = sub { $warning .= "@_"; warn @_; }; 46 47 my $rv = eval { $tar->extract } || 0; 48 ok( !$@, " No fatal error" ); 49 is( !!$rv, !!$expect, " RV as expected" ); 50 like( $warning, $regex, " Error matches $regex" ); 51 52 rmtree( 'linktest' ); 53 } 54 } 55} 56