This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
865cf04e48f9d0c9887b407220a29d131475c6af
[perl5.git] / lib / Archive / Tar / t / 04_resolved_issues.t
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 Test::More 'no_plan';
11 use strict;
12 use lib '../lib';
13
14 my $NO_UNLINK   = @ARGV ? 1 : 0;
15
16 my $Class       = 'Archive::Tar';
17
18 use_ok( $Class );
19
20 ### bug #13636
21 ### tests for @longlink behaviour on files that have a / at the end
22 ### of their shortened path, making them appear to be directories
23 {   ### dont use the prefix, otherwise A::T will not use @longlink
24     ### encoding style
25     local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
26     local $Archive::Tar::DO_NOT_USE_PREFIX = 1;
27     
28     my $dir =   'Catalyst-Helper-Controller-Scaffold-HTML-Template-0.03/' . 
29                 'lib/Catalyst/Helper/Controller/Scaffold/HTML/';
30     my $file =  'Template.pm';
31     my $out =   $$ . '.tar';
32     
33     ### first create the file
34     {   my $tar = $Class->new;
35         
36         isa_ok( $tar,           $Class );
37         ok( $tar->add_data( $dir.$file => $$ ),
38                                 "   Added long file" );
39         
40         ok( $tar->write($out),  "   File written to $out" );
41     }
42     
43     ### then read it back in
44     {   my $tar = $Class->new;
45         isa_ok( $tar,           $Class );
46         ok( $tar->read( $out ), "   Read in $out again" );
47         
48         my @files = $tar->get_files;
49         is( scalar(@files), 1,  "   Only 1 entry found" );
50         
51         my $entry = shift @files;
52         ok( $entry->is_file,    "   Entry is a file" );
53         is( $entry->name, $dir.$file,
54                                 "   With the proper name" );
55     }                                
56     
57     ### remove the file
58     unless( $NO_UNLINK ) { 1 while unlink $out }
59 }