Skip to content

Commit

Permalink
refactor: improved test feedback
Browse files Browse the repository at this point in the history 
Also replaced double quotes were they aren't necessary.
  • Loading branch information
@glasswalk3r
glasswalk3r committed Jun 10, 2024
1 parent e57f7bb commit 71c308a
Showing 1 changed file with 49 additions and 41 deletions.
90 changes: 49 additions & 41 deletions t/001Basic.t
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
use warnings;
use strict;
use Log::Log4perl qw(:easy);
use FindBin qw($Bin);
use File::Temp qw(tempfile);
use FindBin qw($Bin);
use File::Temp qw(tempfile);
use Test::More tests => 24;
use File::Spec;
use Config;
Expand All @@ -15,11 +15,12 @@ BEGIN { use_ok('Archive::Tar::Wrapper') }
umask(0);
my $arch = Archive::Tar::Wrapper->new();

diag('Is GNU tar? ' . $arch->is_gnu);
diag('Is BSD tar? ' . $arch->is_bsd);
diag( 'Is GNU tar? ' . ( $arch->is_gnu ? 'yes' : 'no' ) );
diag( 'Is BSD tar? ' . ( $arch->is_bsd ? 'yes' : 'no' ) );
diag( 'Version information: ' . $arch->{version_info} );
diag( 'tar error: ' . $arch->{tar_error_msg} )
if (defined($arch->{tar_error_msg}));
if ( ( defined( $arch->{tar_error_msg} ) )
and ( $arch->{tar_error_msg} ne '' ) );

ok( $arch->read( File::Spec->catfile( TARDIR, 'foo.tgz' ) ),
'can open the compressed tar file' );
Expand All @@ -31,21 +32,22 @@ ok( !$arch->locate('nonexist'),
'cannot find non-existing file inside the compressed tar file' );

note('Add a new file');
my $tmploc = $arch->locate("001Basic.t");
ok( $arch->add( "foo/bar/baz", $tmploc ), "adding file" );
my $tmploc = $arch->locate('001Basic.t');
ok( $arch->add( 'foo/bar/baz', $tmploc ), 'adding file' );

note('Add data');
my $data = "this is data";
ok( $arch->add( "foo/bar/string", \$data ), "adding data" );
ok( $arch->locate("foo/bar/baz"), "find added file" );
ok( $arch->add( "foo/bar/permtest", $tmploc, { perm => oct(770) } ), "adding file" );
my $data = 'this is data';
ok( $arch->add( 'foo/bar/string', \$data ), 'adding data' );
ok( $arch->locate('foo/bar/baz'), 'find added file' );
ok( $arch->add( 'foo/bar/permtest', $tmploc, { perm => oct(770) } ),
'adding file' );

note('Make a tarball');
my ( $fh, $filename ) = tempfile( UNLINK => 1 );
ok( $arch->write($filename), "Tarring up" );
ok( $arch->write($filename), 'Tarring up' );

my $a2 = Archive::Tar::Wrapper->new();
ok( $a2->read($filename), "Reading in new tarball" );
ok( $a2->read($filename), 'Reading in new tarball' );

my @got = sort( map { $_->[0] } @{ $a2->list_all } );
is_deeply(
Expand All @@ -54,28 +56,31 @@ is_deeply(
'list_all() returns the expected list elements'
);

my $f1 = $a2->locate("001Basic.t");
my $f2 = $a2->locate("foo/bar/baz");
ok( -s $f1 > 0, "Checking tarball files sizes" );
ok( -s $f2 > 0, "Checking tarball files sizes" );
my $f1 = $a2->locate('001Basic.t');
my $f2 = $a2->locate('foo/bar/baz');
ok( -s $f1 > 0, 'Checking tarball files sizes' );
ok( -s $f2 > 0, 'Checking tarball files sizes' );

is( -s $f1, -s $f2, "Comparing tarball files sizes" );
is( -s $f1, -s $f2, 'Comparing tarball files sizes' );

my $f3 = $a2->locate("foo/bar/permtest");
my $perm = ( ( stat($f3) )[2] & oct('777') );
my $f3 = $a2->locate('foo/bar/permtest');
my $expected_permission = sprintf '%3o', ( ( stat($f3) )[2] & 07777 );

SKIP: {
skip 'Permissions are too different on Microsoft Windows', 1 if ($Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys');
is( $perm, oct(770), 'testing file permission inside the tarball' );
skip 'Permissions are too different on Microsoft Windows', 1
if ( $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys' );
is( $expected_permission, '770',
'testing file permission inside the tarball' );
}

my $f4 = $a2->locate("foo/bar/string");
my $f4 = $a2->locate('foo/bar/string');
open( my $in, '<', $f4 ) or die "Cannot open $f4: $!";
my $got_data = join '', <$in>;
close($in);
is( $got_data, $data, "comparing file data" );
is( $got_data, $data, 'comparing file data' );

note('Iterators');

# required to be invoke since list_all() invokes it implicit
$arch->list_reset();
my @elements;
Expand All @@ -102,23 +107,25 @@ note('Ask for non-existent files in tarball');
my $a4 = Archive::Tar::Wrapper->new();

# Suppress the warning
Log::Log4perl->get_logger("")->level($FATAL);
Log::Log4perl->get_logger('')->level($FATAL);

SKIP: {
skip( "FreeBSD's tar is too lenient - skipping", 1 ) if ( $^O =~ /freebsd/i );
skip( 'FreeBSD\'s tar is too lenient - skipping', 1 )
if ( $^O =~ /freebsd/i );
skip 'bsdtar is too lenient', 1 if ( $a4->is_bsd() );
my $rc = $a4->read( File::Spec->catfile( TARDIR, 'bar.tar' ), 'bar/bar.dat', 'quack/schmack' );
is( $rc, undef, "Failure to ask for non-existent files" );
my $rc = $a4->read( File::Spec->catfile( TARDIR, 'bar.tar' ),
'bar/bar.dat', 'quack/schmack' );
is( $rc, undef, 'Failure to ask for non-existent files' );
}

note('Permissions');
umask(022);
note('Testing permissions');
my $a5 = Archive::Tar::Wrapper->new( tar_read_options => 'p', );
$a5->read( File::Spec->catfile( TARDIR, 'bar.tar' ) );
$f1 = $a5->locate('bar/bar.dat');

# TODO: add conditional note on Alpine to indicate that tar over there is broken regarding -p parameter
if ($f1) {
$perm = ( ( stat($f1) )[2] & oct(777) );
$expected_permission = sprintf '%3o', ( ( stat($f1) )[2] & 07777 );
}
else {
note( 'Could not locate "bar/bar.dat" inside the tarball '
Expand All @@ -127,14 +134,15 @@ else {

SKIP: {
skip 'Cannot check permissions on a non-existent file', 1 unless $f1;
skip 'Permissions are too different on Microsoft Windows', 1 if ($Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys');
is( $perm, oct(664), 'testing file permissions' );
skip 'Permissions are too different on Microsoft Windows', 1
if ( $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys' );
is( $expected_permission, '664', 'testing file permissions' );
}

SKIP: {
# gnu options
my $a6 =
Archive::Tar::Wrapper->new( tar_gnu_read_options => ["--numeric-owner"],
Archive::Tar::Wrapper->new( tar_gnu_read_options => ['--numeric-owner'],
);

my $is_gnu = $a6->is_gnu();
Expand All @@ -153,17 +161,17 @@ note('Trying to test GNU options');
SKIP: {
# gnu options
my $tar =
Archive::Tar::Wrapper->new( tar_gnu_write_options => ["--exclude=foo"], );
Archive::Tar::Wrapper->new( tar_gnu_write_options => ['--exclude=foo'], );

my $is_gnu = $tar->is_gnu();
note( $tar->{tar_error_msg} ) if ( defined( $tar->{tar_error_msg} ) );
skip "Test is possible only with GNU tar", 1 unless $is_gnu;
skip 'Test is possible only with GNU tar', 1 unless $is_gnu;

my $file_loc = $tar->locate("001Basic.t");
$tar->add( "foo/bar/baz", $0 );
$tar->add( "boo/bar/baz", $0 );
my $file_loc = $tar->locate('001Basic.t');
$tar->add( 'foo/bar/baz', $0 );
$tar->add( 'boo/bar/baz', $0 );

my ( $fh, $filename ) = tempfile( UNLINK => 1, SUFFIX => ".tgz" );
my ( $fh, $filename ) = tempfile( UNLINK => 1, SUFFIX => '.tgz' );
$tar->write( $filename, 1 );

my $tar_read = Archive::Tar::Wrapper->new();
Expand All @@ -172,6 +180,6 @@ SKIP: {
for my $entry ( @{ $tar_read->list_all() } ) {
my ( $tar_path, $real_path ) = @$entry;

is( $tar_path, "boo/bar/baz", "foo excluded" );
is( $tar_path, 'boo/bar/baz', 'foo excluded' );
}
}

0 comments on commit 71c308a

Please sign in to comment.