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