view release on metacpan or  search on metacpan

t/util.t  view on Meta::CPAN

}

{
    my $scope_cleanup_two_called;
    $@ = '';
    {
	my $sc = new_scope_cleanup sub { die "cleanup callback dies" };
	$sc->add_scope_cleanup(sub { $scope_cleanup_two_called = 1 });
    };
    like $@, qr{cleanup callback dies}, 'failed scope cleanup';
    ok !$scope_cleanup_two_called, '2nd callback not called';
}

{
    my $scope_cleanup_called;
    eval {
	my $scope_cleanup = new_scope_cleanup { $scope_cleanup_called++ };
	error "Failing while in scope cleanup";
    };
    like $@, qr{ERROR.*Failing while in scope cleanup}, 'scope cleanup after failure, in eval';
    is $scope_cleanup_called, 1, 'scope cleanup called';
}

{
    my $scope_cleanup_called;
    eval {
	my $scope_cleanup = new_scope_cleanup { $scope_cleanup_called++ };
	die "Failing while in scope cleanup";
    };
    like $@, qr{^Failing while in scope cleanup}, 'scope cleanup after failure, with die, in eval';
    is $scope_cleanup_called, 1, 'scope cleanup called';
}

SKIP: {
    skip "No fork on Windows", 1 if $^O eq 'MSWin32';
    my $pid = fork;
    error "Can't fork: $!" if !defined $pid;
    if ($pid == 0) {
	my $scope_cleanup = new_scope_cleanup { "do something" };
	error "Failing while in scope cleanup";
	CORE::exit(0); # never reached --- and exitcode=0 would be considered an error in this test
    }
    waitpid $pid, 0;
    isnt $?, 0, 'scope cleanup after failure, in separate process';
}

######################################################################
# copy_stat
{
    my $doit = Doit->init;
    my %sudo_info;
    my $sudo = TestUtil::get_sudo($doit, info => \%sudo_info); # must run in this directory

    my $tempdir = tempdir(TMPDIR => 1, CLEANUP => 1);
    in_directory {
	$doit->create_file_if_nonexisting('source');
	$doit->create_file_if_nonexisting('target');

	my @stat = stat('source');

	$doit->chmod(0600, 'source');
	copy_stat('source', 'target');
	is(((stat('target'))[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0600), 'preserving mode');

	$stat[2] = 0400;
	copy_stat(\@stat, 'target');
	is(((stat('target'))[2] & 07777), ($^O eq 'MSWin32' ? 0444 : 0400), 'preserving mode using stat array');

	$stat[2] = 0644;
	copy_stat(\@stat, 'target', 'mode' => 1);
	is(((stat('target'))[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0644), 'explicit preserve option');

	$stat[2] = 0755;
	copy_stat(\@stat, 'target', 'ownership' => 1);
	is(((stat('target'))[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0644), 'unchanged stat, non-matching preserve option');

	$doit->utime(86400,86400,'source');
	copy_stat('source', 'target');
	is((stat('target'))[8], 86400, 'preserving atime') if $enable_atime_tests;
	is((stat('target'))[9], 86400, 'preserving mtime');

	$stat[8] = $stat[9] = 86400*2;
	copy_stat(\@stat, 'target');
	is((stat('target'))[8], 86400*2, 'preserving atime using stat array') if $enable_atime_tests;
	is((stat('target'))[9], 86400*2, 'preserving mtime using stat array');

	$stat[8] = $stat[9] = 86400*3;
	copy_stat(\@stat, 'target', 'time' => 1);
	is((stat('target'))[8], 86400*3, 'explicit preserve option (atime)') if $enable_atime_tests;
	is((stat('target'))[9], 86400*3, 'explicit preserve option (mtime)');

	$stat[8] = $stat[9] = 86400*4;
	copy_stat(\@stat, 'target', 'mode' => 1);
	is((stat('target'))[8], 86400*3, 'unchanged atime, non-matching preserve option') if $enable_atime_tests;
	is((stat('target'))[9], 86400*3, 'unchanged mtime, non-matching preserve option');

	# Must be last in this block --- source+target are deleted
    SKIP: {
	    skip "Can't sudo: $sudo_info{error}", 2 if !$sudo;
	    $sudo->chown(0,0,"$tempdir/source");
	    $sudo->call_with_runner('run_copy_stat', "$tempdir/source", "$tempdir/target"); # NOTE: directory change does not apply to sudo context XXX would be nicer if $sudo->copy_stat could be used
	    is((stat('target'))[4], 0, 'preserving owner');
	    is((stat('target'))[5], 0, 'preserving group');
	    $sudo->unlink(qw(source target));
	}
    } $tempdir;
}

__END__