Your IP : 216.73.216.86
t/lib/TryUser.pm 0000644 00000000215 15170004073 0007523 0 ustar 00 package TryUser;
use Try::Tiny;
sub test_try { try { } }
sub test_catch { try { } catch { } }
sub test_finally { try { } finally { } }
1;
t/00-report-prereqs.dd 0000644 00000024112 15170004073 0010524 0 ustar 00 do { my $x = {
'configure' => {
'requires' => {
'ExtUtils::MakeMaker' => '0',
'perl' => '5.006'
},
'suggests' => {
'JSON::PP' => '2.27300'
}
},
'develop' => {
'recommends' => {
'Dist::Zilla::PluginBundle::Author::ETHER' => '0.132'
},
'requires' => {
'Capture::Tiny' => '0.12',
'Encode' => '0',
'File::Spec' => '0',
'IO::Handle' => '0',
'IPC::Open3' => '0',
'Pod::Coverage::TrustPod' => '0',
'Pod::Wordlist' => '0',
'Sub::Name' => '0.08',
'Sub::Util' => '0',
'Test::CPAN::Changes' => '0.19',
'Test::CPAN::Meta' => '0',
'Test::EOL' => '0',
'Test::Kwalitee' => '1.21',
'Test::MinimumVersion' => '0',
'Test::Mojibake' => '0',
'Test::More' => '0.96',
'Test::NoTabs' => '0',
'Test::Pod' => '1.41',
'Test::Pod::Coverage' => '1.08',
'Test::Pod::No404s' => '0',
'Test::Portability::Files' => '0',
'Test::Spelling' => '0.12'
},
'suggests' => {
'Dist::Zilla' => '5',
'Dist::Zilla::Plugin::Authority' => '1.009',
'Dist::Zilla::Plugin::AutoMetaResources' => '0',
'Dist::Zilla::Plugin::AutoPrereqs' => '5.038',
'Dist::Zilla::Plugin::Breaks' => '0',
'Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional' => '0.004',
'Dist::Zilla::Plugin::CheckIssues' => '0',
'Dist::Zilla::Plugin::CheckMetaResources' => '0',
'Dist::Zilla::Plugin::CheckPrereqsIndexed' => '0.019',
'Dist::Zilla::Plugin::CheckSelfDependency' => '0',
'Dist::Zilla::Plugin::CheckStrictVersion' => '0',
'Dist::Zilla::Plugin::ConfirmRelease' => '0',
'Dist::Zilla::Plugin::CopyFilesFromRelease' => '0',
'Dist::Zilla::Plugin::EnsureLatestPerl' => '0',
'Dist::Zilla::Plugin::FileFinder::ByName' => '0',
'Dist::Zilla::Plugin::FileFinder::Filter' => '0',
'Dist::Zilla::Plugin::GenerateFile::FromShareDir' => '0',
'Dist::Zilla::Plugin::Git::Check' => '0',
'Dist::Zilla::Plugin::Git::CheckFor::CorrectBranch' => '0.004',
'Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts' => '0',
'Dist::Zilla::Plugin::Git::Commit' => '2.020',
'Dist::Zilla::Plugin::Git::Contributors' => '0.029',
'Dist::Zilla::Plugin::Git::Describe' => '0.004',
'Dist::Zilla::Plugin::Git::GatherDir' => '2.016',
'Dist::Zilla::Plugin::Git::Push' => '0',
'Dist::Zilla::Plugin::Git::Remote::Check' => '0',
'Dist::Zilla::Plugin::Git::Tag' => '0',
'Dist::Zilla::Plugin::GitHub::Update' => '0.40',
'Dist::Zilla::Plugin::GithubMeta' => '0.54',
'Dist::Zilla::Plugin::InstallGuide' => '1.200005',
'Dist::Zilla::Plugin::Keywords' => '0.004',
'Dist::Zilla::Plugin::License' => '5.038',
'Dist::Zilla::Plugin::MakeMaker' => '0',
'Dist::Zilla::Plugin::Manifest' => '0',
'Dist::Zilla::Plugin::MetaConfig' => '0',
'Dist::Zilla::Plugin::MetaJSON' => '0',
'Dist::Zilla::Plugin::MetaNoIndex' => '0',
'Dist::Zilla::Plugin::MetaProvides::Package' => '1.15000002',
'Dist::Zilla::Plugin::MetaTests' => '0',
'Dist::Zilla::Plugin::MetaYAML' => '0',
'Dist::Zilla::Plugin::MinimumPerl' => '1.006',
'Dist::Zilla::Plugin::MojibakeTests' => '0.8',
'Dist::Zilla::Plugin::NextRelease' => '5.033',
'Dist::Zilla::Plugin::OnlyCorePrereqs' => '0',
'Dist::Zilla::Plugin::PodCoverageTests' => '5.040',
'Dist::Zilla::Plugin::PodSyntaxTests' => '5.040',
'Dist::Zilla::Plugin::PodWeaver' => '4.005',
'Dist::Zilla::Plugin::Prereqs' => '0',
'Dist::Zilla::Plugin::Prereqs::AuthorDeps' => '0.006',
'Dist::Zilla::Plugin::Prereqs::Soften' => '0',
'Dist::Zilla::Plugin::PromptIfStale' => '0',
'Dist::Zilla::Plugin::Readme' => '0',
'Dist::Zilla::Plugin::ReadmeAnyFromPod' => '0.142180',
'Dist::Zilla::Plugin::RewriteVersion::Transitional' => '0.004',
'Dist::Zilla::Plugin::Run::AfterBuild' => '0.041',
'Dist::Zilla::Plugin::Run::AfterRelease' => '0.038',
'Dist::Zilla::Plugin::RunExtraTests' => '0.024',
'Dist::Zilla::Plugin::StaticInstall' => '0.005',
'Dist::Zilla::Plugin::Substitute' => '0',
'Dist::Zilla::Plugin::Test::CPAN::Changes' => '0.012',
'Dist::Zilla::Plugin::Test::ChangesHasContent' => '0',
'Dist::Zilla::Plugin::Test::CheckBreaks' => '0.018',
'Dist::Zilla::Plugin::Test::Compile' => '2.039',
'Dist::Zilla::Plugin::Test::EOL' => '0.17',
'Dist::Zilla::Plugin::Test::Kwalitee' => '2.10',
'Dist::Zilla::Plugin::Test::MinimumVersion' => '2.000003',
'Dist::Zilla::Plugin::Test::NoTabs' => '0.08',
'Dist::Zilla::Plugin::Test::Pod::No404s' => '1.003',
'Dist::Zilla::Plugin::Test::PodSpelling' => '2.006003',
'Dist::Zilla::Plugin::Test::Portability' => '2.000007',
'Dist::Zilla::Plugin::Test::ReportPrereqs' => '0.022',
'Dist::Zilla::Plugin::TestRelease' => '0',
'Dist::Zilla::Plugin::UploadToCPAN' => '0',
'Dist::Zilla::Plugin::UseUnsafeInc' => '0',
'Dist::Zilla::PluginBundle::Author::ETHER' => '0.119',
'Dist::Zilla::PluginBundle::Git::VersionManager' => '0',
'Software::License::MIT' => '0'
}
},
'runtime' => {
'requires' => {
'Carp' => '0',
'Exporter' => '5.57',
'constant' => '0',
'perl' => '5.006',
'strict' => '0',
'warnings' => '0'
},
'suggests' => {
'Sub::Name' => '0.08',
'Sub::Util' => '0'
}
},
'test' => {
'recommends' => {
'CPAN::Meta' => '2.120900'
},
'requires' => {
'ExtUtils::MakeMaker' => '0',
'File::Spec' => '0',
'Test::More' => '0',
'if' => '0',
'perl' => '5.006'
},
'suggests' => {
'CPAN::Meta::Check' => '0.011',
'CPAN::Meta::Requirements' => '0',
'Capture::Tiny' => '0.12'
}
}
};
$x;
} t/00-report-prereqs.t 0000644 00000013515 15170004073 0010405 0 ustar 00 #!perl
use strict;
use warnings;
# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027
use Test::More tests => 1;
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
(?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
)
)/x;
# hide optional CPAN::Meta modules from prereq scanner
# and check if they are available
my $cpan_meta = "CPAN::Meta";
my $cpan_meta_pre = "CPAN::Meta::Prereqs";
my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
# Verify requirements?
my $DO_VERIFY_PREREQS = 1;
sub _max {
my $max = shift;
$max = ( $_ > $max ) ? $_ : $max for @_;
return $max;
}
sub _merge_prereqs {
my ($collector, $prereqs) = @_;
# CPAN::Meta::Prereqs object
if (ref $collector eq $cpan_meta_pre) {
return $collector->with_merged_prereqs(
CPAN::Meta::Prereqs->new( $prereqs )
);
}
# Raw hashrefs
for my $phase ( keys %$prereqs ) {
for my $type ( keys %{ $prereqs->{$phase} } ) {
for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
$collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
}
}
}
return $collector;
}
my @include = qw(
JSON::PP
Pod::Coverage
Sub::Name
YAML
autodie
);
my @exclude = qw(
);
# Add static prereqs to the included modules list
my $static_prereqs = do './t/00-report-prereqs.dd';
# Merge all prereqs (either with ::Prereqs or a hashref)
my $full_prereqs = _merge_prereqs(
( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
my $cpan_meta_error;
if ( $source && $HAS_CPAN_META
&& (my $meta = eval { CPAN::Meta->load_file($source) } )
) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
else {
$cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source)
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
}
for my $phase ( qw(configure build test runtime develop other) ) {
next unless $req_hash->{$phase};
next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
for my $type ( qw(requires recommends suggests conflicts modules) ) {
next unless $req_hash->{$phase}{$type};
my $title = ucfirst($phase).' '.ucfirst($type);
my @reports = [qw/Module Want Have/];
for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
next if $mod eq 'perl';
next if grep { $_ eq $mod } @exclude;
my $file = $mod;
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
}
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( $cpan_meta_error || @dep_errors ) {
diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n";
}
if ( $cpan_meta_error ) {
my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n";
}
if ( @dep_errors ) {
diag join("\n",
"\nThe following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass;
# vim: ts=4 sts=4 sw=4 et:
t/basic.t 0000644 00000005773 15170004073 0006266 0 ustar 00 use strict;
use warnings;
use Test::More tests => 25;
use Try::Tiny;
sub _eval {
local $@;
local $Test::Builder::Level = $Test::Builder::Level + 2;
return ( scalar(eval { $_[0]->(); 1 }), $@ );
}
sub lives_ok (&$) {
my ( $code, $desc ) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ( $ok, $error ) = _eval($code);
ok($ok, $desc );
diag "error: $@" unless $ok;
}
sub throws_ok (&$$) {
my ( $code, $regex, $desc ) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ( $ok, $error ) = _eval($code);
if ( $ok ) {
fail($desc);
} else {
like($error || '', $regex, $desc );
}
}
my $prev;
lives_ok {
try {
die "foo";
};
} "basic try";
throws_ok {
try {
die "foo";
} catch { die $_ };
} qr/foo/, "rethrow";
{
local $@ = "magic";
is( try { 42 }, 42, "try block evaluated" );
is( $@, "magic", '$@ untouched' );
}
{
local $@ = "magic";
is( try { die "foo" }, undef, "try block died" );
is( $@, "magic", '$@ untouched' );
}
{
local $@ = "magic";
like( (try { die "foo" } catch { $_ }), qr/foo/, "catch block evaluated" );
is( $@, "magic", '$@ untouched' );
}
is( scalar(try { "foo", "bar", "gorch" }), "gorch", "scalar context try" );
is_deeply( [ try {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context try" );
is( scalar(try { die } catch { "foo", "bar", "gorch" }), "gorch", "scalar context catch" );
is_deeply( [ try { die } catch {qw(foo bar gorch)} ], [qw(foo bar gorch)], "list context catch" );
{
my ($sub) = catch { my $a = $_; };
is(ref($sub), 'Try::Tiny::Catch', 'Checking catch subroutine scalar reference is correctly blessed');
}
{
my ($sub) = finally { my $a = $_; };
is(ref($sub), 'Try::Tiny::Finally', 'Checking finally subroutine scalar reference is correctly blessed');
}
lives_ok {
try {
die "foo";
} catch {
my $err = shift;
try {
like $err, qr/foo/;
} catch {
fail("shouldn't happen");
};
pass "got here";
}
} "try in try catch block";
throws_ok {
try {
die "foo";
} catch {
my $err = shift;
try { } catch { };
die "rethrowing $err";
}
} qr/rethrowing foo/, "rethrow with try in catch block";
sub Evil::DESTROY {
eval { "oh noes" };
}
sub Evil::new { bless { }, $_[0] }
{
local $@ = "magic";
local $_ = "other magic";
try {
my $object = Evil->new;
die "foo";
} catch {
pass("catch invoked");
local $TODO = "i don't think we can ever make this work sanely, maybe with SIG{__DIE__}" if "$]" < 5.014;
like($_, qr/foo/);
};
is( $@, "magic", '$@ untouched' );
is( $_, "other magic", '$_ untouched' );
}
{
my ( $caught, $prev );
{
local $@;
eval { die "bar\n" };
is( $@, "bar\n", 'previous value of $@' );
try {
die {
prev => $@,
}
} catch {
$caught = $_;
$prev = $@;
}
}
is_deeply( $caught, { prev => "bar\n" }, 'previous value of $@ available for capture' );
is( $prev, "bar\n", 'previous value of $@ also available in catch block' );
}
t/context.t 0000644 00000002253 15170004073 0006657 0 ustar 00 use strict;
use warnings;
use Test::More;
use Try::Tiny;
plan tests =>
(4+1) * 2 # list/scalar with exception (try + catch + 2 x finally) + is_deeply
+ 4 # void with exception
+ (3+1) * 2 # list/scalar no exception (try + 2 x finally) + is_deeply
+ 3 # void no exception
;
my $ctx_index = {
VOID => undef,
LIST => 1,
SCALAR => '',
};
my ($ctx, $die);
for (sort keys %$ctx_index) {
$ctx = $_;
for (0,1) {
$die = $_;
if ($ctx_index->{$ctx}) {
is_deeply(
[ run() ],
[ $die ? 'catch' : 'try' ],
);
}
elsif (defined $ctx_index->{$ctx}) {
is_deeply(
[ scalar run() ],
[ $die ? 'catch' : 'try' ],
);
}
else {
run();
1;
}
}
}
sub run {
try {
is (wantarray, $ctx_index->{$ctx}, "Proper context $ctx in try{}");
die if $die;
return 'try';
}
catch {
is (wantarray, $ctx_index->{$ctx}, "Proper context $ctx in catch{}");
return 'catch';
}
finally {
is (wantarray, undef, "Proper VOID context in finally{} 1");
return 'finally';
}
finally {
is (wantarray, undef, "Proper VOID context in finally{} 2");
return 'finally';
};
}
t/erroneous_usage.t 0000644 00000003003 15170004073 0010372 0 ustar 00 use strict;
use warnings;
use Test::More tests => 8;
use Try::Tiny;
sub _eval {
local $@;
local $Test::Builder::Level = $Test::Builder::Level + 2;
return ( scalar(eval { $_[0]->(); 1 }), $@ );
}
sub throws_ok (&$$) {
my ( $code, $regex, $desc ) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ( $ok, $error ) = _eval($code);
if ( $ok ) {
fail($desc);
} else {
like($error || '', $regex, $desc );
}
}
throws_ok {
try { 1 }; catch { 2 };
} qr/\QUseless bare catch()/, 'Bare catch() detected';
throws_ok {
try { 1 }; finally { 2 };
} qr/\QUseless bare finally()/, 'Bare finally() detected';
throws_ok {
try { 1 }; catch { 2 } finally { 2 };
} qr/\QUseless bare catch()/, 'Bare catch()/finally() detected';
throws_ok {
try { 1 }; finally { 2 } catch { 2 };
} qr/\QUseless bare finally()/, 'Bare finally()/catch() detected';
throws_ok {
try { 1 } catch { 2 } catch { 3 } finally { 4 } finally { 5 }
} qr/\QA try() may not be followed by multiple catch() blocks/, 'Multi-catch detected';
throws_ok {
try { 1 } catch { 2 }
do { 2 }
} qr/\Qtry() encountered an unexpected argument (2) - perhaps a missing semi-colon before or at/,
'Unterminated try detected';
sub foo {
try { 0 }; catch { 2 }
}
throws_ok {
if (foo()) {
# ...
}
} qr/\QUseless bare catch/,
'Bare catch at the end of a function call';
sub bar {
try { 0 }; finally { 2 }
}
throws_ok {
if (bar()) {
# ...
}
} qr/\QUseless bare finally/,
'Bare finally at the end of a function call';
t/finally.t 0000644 00000005002 15170004073 0006624 0 ustar 00 use strict;
use warnings;
use Test::More tests => 30;
use Try::Tiny;
try {
my $a = 1+1;
} catch {
fail('Cannot go into catch block because we did not throw an exception')
} finally {
pass('Moved into finally from try');
};
try {
die('Die');
} catch {
ok($_ =~ /Die/, 'Error text as expected');
pass('Into catch block as we died in try');
} finally {
pass('Moved into finally from catch');
};
try {
die('Die');
} finally {
pass('Moved into finally from catch');
} catch {
ok($_ =~ /Die/, 'Error text as expected');
};
try {
die('Die');
} finally {
pass('Moved into finally block when try throws an exception and we have no catch block');
};
try {
die('Die');
} finally {
pass('First finally clause run');
} finally {
pass('Second finally clause run');
};
try {
# do not die
} finally {
if (@_) {
fail("errors reported: @_");
} else {
pass("no error reported") ;
}
};
try {
die("Die\n");
} finally {
is_deeply(\@_, [ "Die\n" ], "finally got passed the exception");
};
try {
try {
die "foo";
}
catch {
die "bar";
}
finally {
pass("finally called");
};
};
$_ = "foo";
try {
is($_, "foo", "not localized in try");
}
catch {
}
finally {
is(scalar(@_), 0, "nothing in \@_ (finally)");
is($_, "foo", "\$_ not localized (finally)");
};
is($_, "foo", "same afterwards");
$_ = "foo";
try {
is($_, "foo", "not localized in try");
die "bar\n";
}
catch {
is($_[0], "bar\n", "error in \@_ (catch)");
is($_, "bar\n", "error in \$_ (catch)");
}
finally {
is(scalar(@_), 1, "error in \@_ (finally)");
is($_[0], "bar\n", "error in \@_ (finally)");
is($_, "foo", "\$_ not localized (finally)");
};
is($_, "foo", "same afterwards");
{
my @warnings;
local $SIG{__WARN__} = sub {
$_[0] =~ /\QExecution of finally() block CODE(0x\E.+\Q) resulted in an exception/
? push @warnings, @_
: warn @_
};
try {
die 'tring'
} finally {
die 'fin 1'
} finally {
pass('fin 2 called')
} finally {
die 'fin 3'
};
is( scalar @warnings, 2, 'warnings from both fatal finally blocks' );
my @originals = sort map { $_ =~ /Original exception text follows:\n\n(.+)/s } @warnings;
like $originals[0], qr/fin 1 at/, 'First warning contains original exception';
like $originals[1], qr/fin 3 at/, 'Second warning contains original exception';
}
{
my $finally;
SKIP: {
try {
pass('before skip in try');
skip 'whee', 1;
fail('not reached');
} finally {
$finally = 1;
};
}
ok $finally, 'finally ran';
}
t/given_when.t 0000644 00000001266 15170004073 0007327 0 ustar 00 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'Perl 5.010 is required' unless "$]" >= '5.010';
plan skip_all => 'Tests skipped on perl 5.27.7+, pending resolution of smartmatch changes' if "$]" >= '5.027007';
plan tests => 2;
}
use Try::Tiny;
use 5.010;
no if "$]" >= 5.017011, warnings => 'experimental::smartmatch';
my ( $error, $topic );
given ("foo") {
when (qr/./) {
try {
die "blah\n";
} catch {
$topic = $_;
$error = $_[0];
}
};
}
is( $error, "blah\n", "error caught" );
{
local $TODO = "perhaps a workaround can be found"
if "$]" < 5.017003;
is( $topic, $error, 'error is also in $_' );
}
# ex: set sw=4 et:
t/global_destruction_forked.t 0000644 00000001671 15170004073 0012413 0 ustar 00 use strict;
use warnings;
use Test::More tests => 3;
use Try::Tiny;
{
package WithCatch;
use Try::Tiny;
sub DESTROY {
try {}
catch {};
return;
}
}
{
package WithFinally;
use Try::Tiny;
our $_in_destroy;
sub DESTROY {
local $_in_destroy = 1;
try {}
finally {};
return;
}
}
try {
my $pid = fork;
unless ($pid) {
my $o = bless {}, 'WithCatch';
$SIG{__DIE__} = sub {
exit 1
if $_[0] =~ /A try\(\) may not be followed by multiple catch\(\) blocks/;
exit 2;
};
exit 0;
}
waitpid $pid, 0;
is $?, 0, 'nested try in cleanup after fork does not maintain outer catch block';
}
catch {};
try {
my $pid = fork;
unless ($pid) {
my $o = bless {}, 'WithFinally';
exit 0;
}
waitpid $pid, 0;
is $?, 0, 'nested try in cleanup after fork does not maintain outer finally block';
}
finally { exit 1 if $WithFinally::_in_destroy };
pass("Didn't just exit");
t/global_destruction_load.t 0000644 00000001046 15170004073 0012054 0 ustar 00 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'Capture::Tiny 0.12 required'
unless eval { require Capture::Tiny; Capture::Tiny->VERSION(0.12); 1 };
plan tests => 3;
Capture::Tiny->import(qw(capture_stderr));
}
for my $func (qw(try catch finally)) {
is capture_stderr {
system $^X, qw(-It/lib -we),
qq{sub DESTROY { require TryUser; TryUser->test_$func }} .
q{our $o; $o = bless []};
}, '', "$func gets installed when loading Try::Tiny during global destruction";
}
t/named.t 0000644 00000001255 15170004073 0006260 0 ustar 00 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => "Sub::Util or Sub::Name required"
unless eval { require Sub::Util; defined &Sub::Util::set_subname; }
|| eval { require Sub::Name; Sub::Name->VERSION(0.08) };
plan tests => 3;
}
use Try::Tiny;
my $name;
try {
$name = (caller(0))[3];
};
is $name, "main::try {...} ", "try name"; # note extra space
try {
die "Boom";
} catch {
$name = (caller(0))[3];
};
is $name, "main::catch {...} ", "catch name"; # note extra space
try {
die "Boom";
} catch {
# noop
} finally {
$name = (caller(0))[3];
};
is $name, "main::finally {...} ", "finally name"; # note extra space
t/when.t 0000644 00000001235 15170004073 0006133 0 ustar 00 use strict;
use warnings;
use Test::More;
BEGIN {
plan skip_all => 'Perl 5.010 is required' unless "$]" >= '5.010';
plan skip_all => 'Tests skipped on perl 5.27.7+, pending resolution of smartmatch changes' if "$]" >= '5.027007';
plan tests => 5;
}
use Try::Tiny;
use 5.010;
no if "$]" >= 5.017011, warnings => 'experimental::smartmatch';
my ( $foo, $bar, $other );
$_ = "magic";
try {
die "foo";
} catch {
like( $_, qr/foo/ );
when (/bar/) { $bar++ };
when (/foo/) { $foo++ };
default { $other++ };
};
is( $_, "magic", '$_ not clobbered' );
ok( !$bar, "bar didn't match" );
ok( $foo, "foo matched" );
ok( !$other, "fallback didn't match" );
t/zzz-check-breaks.t 0000644 00000002102 15170004073 0010341 0 ustar 00 use strict;
use warnings;
# this test was generated with Dist::Zilla::Plugin::Test::CheckBreaks 0.019
use Test::More tests => 2;
SKIP: {
skip 'no conflicts module found to check against', 1;
}
SKIP: {
# this data duplicates x_breaks in META.json
my $breaks = {
"Try::Tiny::Except" => "<= 0.01"
};
skip 'This information-only test requires CPAN::Meta::Requirements', 1
if not eval { +require CPAN::Meta::Requirements };
skip 'This information-only test requires CPAN::Meta::Check 0.011', 1
if not eval { +require CPAN::Meta::Check; CPAN::Meta::Check->VERSION(0.011) };
my $reqs = CPAN::Meta::Requirements->new;
$reqs->add_string_requirement($_, $breaks->{$_}) foreach keys %$breaks;
our $result = CPAN::Meta::Check::check_requirements($reqs, 'conflicts');
if (my @breaks = grep { defined $result->{$_} } keys %$result)
{
diag 'Breakages found with Try-Tiny:';
diag "$result->{$_}" for sort @breaks;
diag "\n", 'You should now update these modules!';
}
pass 'checked x_breaks data';
}
CONTRIBUTING 0000644 00000007021 15170004073 0006373 0 ustar 00
CONTRIBUTING
Thank you for considering contributing to this distribution. This file
contains instructions that will help you work with the source code.
PLEASE NOTE that if you have any questions or difficulties, you can reach the
maintainer(s) through the bug queue described later in this document
(preferred), or by emailing the releaser directly. You are not required to
follow any of the steps in this document to submit a patch or bug report;
these are just recommendations, intended to help you (and help us help you
faster).
The distribution is managed with Dist::Zilla (https://metacpan.org/release/Dist-Zilla).
This means than many of the usual files you might expect are not in the
repository, but are generated at release time (e.g. Makefile.PL).
However, you can run tests directly using the 'prove' tool:
$ prove -l
$ prove -lv t/some_test_file.t
$ prove -lvr t/
In most cases, 'prove' is entirely sufficient for you to test any
patches you have.
You may need to satisfy some dependencies. The easiest way to satisfy
dependencies is to install the last release -- this is available at
https://metacpan.org/release/Try-Tiny
If you use cpanminus, you can do it without downloading the tarball first:
$ cpanm --reinstall --installdeps --with-recommends Try::Tiny
Dist::Zilla is a very powerful authoring tool, but requires a number of
author-specific plugins. If you would like to use it for contributing,
install it from CPAN, then run one of the following commands, depending on
your CPAN client:
$ cpan `dzil authordeps --missing`
or
$ dzil authordeps --missing | cpanm
You should then also install any additional requirements not needed by the
dzil build but may be needed by tests or other development:
$ cpan `dzil listdeps --author --missing`
or
$ dzil listdeps --author --missing | cpanm
Or, you can use the 'dzil stale' command to install all requirements at once:
$ cpan Dist::Zilla::App::Command::stale
$ cpan `dzil stale --all`
or
$ cpanm Dist::Zilla::App::Command::stale
$ dzil stale --all | cpanm
You can also do this via cpanm directly:
$ cpanm --reinstall --installdeps --with-develop --with-recommends Try::Tiny
Once installed, here are some dzil commands you might try:
$ dzil build
$ dzil test
$ dzil test --release
$ dzil xtest
$ dzil listdeps --json
$ dzil build --notgz
You can learn more about Dist::Zilla at http://dzil.org/.
The code for this distribution is hosted at GitHub. The repository is:
https://github.com/p5sagit/Try-Tiny
You can submit code changes by forking the repository, pushing your code
changes to your clone, and then submitting a pull request. Detailed
instructions for doing that is available here:
https://help.github.com/articles/creating-a-pull-request
If you have found a bug, but do not have an accompanying patch to fix it, you
can submit an issue report here:
https://rt.cpan.org/Public/Dist/Display.html?Name=Try-Tiny
or via email: bug-Try-Tiny@rt.cpan.org
This is a good place to send your questions about the usage of this distribution.
If you send me a patch or pull request, your name and email address will be
included in the documentation as a contributor (using the attribution on the
commit or patch), unless you specifically request for it not to be. If you
wish to be listed under a different name or address, you should submit a pull
request to the .mailmap file to contain the correct mapping.
This file was generated via Dist::Zilla::Plugin::GenerateFile::FromShareDir 0.013 from a
template file originating in Dist-Zilla-PluginBundle-Author-ETHER-0.132.
Changes 0000644 00000007615 15170004073 0006045 0 ustar 00 Revision history for Try-Tiny
0.30 2017-12-21 07:23:03Z
- expand "when" test skippage to more perl versions
0.29 2017-12-19 03:51:26Z
- skip tests of "when" and "given/when" usage for perl 5.27.7 *only* (see
RT#123908)
0.28 2017-01-09 01:21:33Z
- enabled some tests of finally blocks that were disabled on 5.6, now that
that functionality works (since 0.13) (Pali, PR#4)
0.27 2016-08-16 01:43:35Z
- repository moved to the github p5sagit organization (the primary is on
shadowcat, mirrored to github)
- no changes since 0.26
0.26 2016-03-15 23:42:02Z (TRIAL RELEASE)
- switch from finalizers using an array to a hash, to resolve segfaults when
creating a pseudofork on MSWin before perl 5.20 (Graham Knop,
karenetheridge/Sub-Name/#3)
0.25 2016-02-22 20:16:51Z (TRIAL RELEASE)
- "finally" blocks are now run for all methods of leaving the try block
(including via exit, goto) (Lukas Mai, RT#112099)
0.24 2015-12-11 05:20:09Z
- fix prereq errors in 0.23
0.23 2015-12-11 04:04:35Z
- fix syntax of example code (Rudolf Leermakers, doy/Sub-Name/#22)
- 'perl' removed from prerequisite recommendations, to avoid tripping up
CPAN clients (Graham Knop)
- Sub::Util is used preferentially to Sub::Name in most cases (Graham Knop,
doy/Sub-Name/#27)
0.22 2014-04-29
- add optional test deps as recommended prereqs (Karen Etheridge,
doy/Sub-Name/#18)
0.21 2014-04-15
- also skip the test if Capture::Tiny is too old (Martin Popel,
doy/Sub-Name/#17)
0.20 2014-03-21
- documentation updates (David Lowe (Flimm), doy/Sub-Name/#15)
0.19 2014-01-22
- fix an obscure issue with loading modules during global destruction
(Dagfinn Ilmari Mannsåker, doy/Sub-Name/#11)
- documentation updates (anaxagoras, doy/Sub-Name/#12)
0.18 2013-08-17
- fix tests for pre-Test-More-0.88 (Paul Howarth, doy/Sub-Name/#10)
0.17 2013-08-16
- work around [rt.perl #119311] which was causing incorrect error messages in
some cases during global destruction (Graham Knop, doy/Sub-Name/#9)
0.16 2013-07-10
- remove accidental Sub::Name test dep
0.15 2013-07-08
- optionally use Sub::Name to name the try/catch/finally blocks, if available
(Mark Fowler)
0.14 2013-07-05
- also throw an exception for catch/finally in scalar context (RT#81070)
0.13 2013-07-04
- fix tests failing on 5.6.x due to differing DESTROY semantics
- excise superfluous local($@) call - 7% speedup
- fix (fsvo) broken URLs (RT#55659)
- proper exception on erroneous usage of bare catch/finally (RT#81070)
- proper exception on erroneous use of multiple catch{} blocks
- clarify exception occuring on unterminated try block (RT#75712)
- fix the prototypes shown in docs to match code (RT#79590; thanks, Pushtaev
Vadim)
- warn loudly on exceptions in finally() blocks
- dzilify
0.12 2013-01-02
- doc fixes
0.11 2011-08-30
- fix broken dist
0.10 2011-04-27
- clarify some docs
0.09 2010-11-28
- don't index Try::Tiny::ScopeGuard
0.08 2010-11-28
- fix require vs use issue in blead (RT63410)
0.07 2010-10-21
- allow multiple finally blocks
- pass the error, if any, to finally blocks when called
0.06 2010-05-27
- in t/given_when.t use a plan instead of done_testing for more backwards
compatibility
0.05 2010-05-26
- Documentation fixes and clarifications
0.04 2010-01-22
- Restore list context propagation for catch blocks
- Fix a bug where finally blocks weren't always invoked
0.03 2010-01-22
- Support for 'finally' blocks (Andy Yates)
- More documentation and tests (many people)
- Sets $@ to the previous value at the beginning of the eval, to allow
the capture of an error stack when calling die.
0.02 2009-09-02
- Doc fixes from chromatic
- Various minor fixes from Adam Kennedy
- Additional documentation and code clarifications
- 5.005_04 compatibility
0.01 2009-08-31
- Initial release
README 0000644 00000000514 15170004073 0005421 0 ustar 00
This archive contains the distribution Try-Tiny,
version 0.30:
Minimal try/catch with proper preservation of $@
This software is Copyright (c) 2009 by יובל קוג'מן (Yuval Kogman).
This is free software, licensed under:
The MIT (X11) License
This README file was generated by Dist::Zilla::Plugin::Readme v6.010.