r57997 - in /trunk/libscope-guard-perl: Changes MANIFEST META.yml Makefile.PL README debian/changelog debian/control debian/copyright debian/rules lib/Scope/Guard.pm t/guard.t t/new.t t/pod.t t/pod_coverage.t t/scope_guard.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Mon May 17 02:34:39 UTC 2010
Author: jawnsy-guest
Date: Mon May 17 02:34:31 2010
New Revision: 57997
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=57997
Log:
* New upstream release
* Add myself to Copyright and Uploaders
* Rewrite control description
* Pod and Coverage tests have been removed, per upstream
Removed:
trunk/libscope-guard-perl/t/pod.t
trunk/libscope-guard-perl/t/pod_coverage.t
Modified:
trunk/libscope-guard-perl/Changes
trunk/libscope-guard-perl/MANIFEST
trunk/libscope-guard-perl/META.yml
trunk/libscope-guard-perl/Makefile.PL
trunk/libscope-guard-perl/README
trunk/libscope-guard-perl/debian/changelog
trunk/libscope-guard-perl/debian/control
trunk/libscope-guard-perl/debian/copyright
trunk/libscope-guard-perl/debian/rules
trunk/libscope-guard-perl/lib/Scope/Guard.pm
trunk/libscope-guard-perl/t/guard.t
trunk/libscope-guard-perl/t/new.t
trunk/libscope-guard-perl/t/scope_guard.t
Modified: trunk/libscope-guard-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/Changes?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/Changes (original)
+++ trunk/libscope-guard-perl/Changes Mon May 17 02:34:31 2010
@@ -1,4 +1,8 @@
Revision history for Perl extension Scope::Guard.
+
+0.20 Sun May 16 08:50:59 2010
+ - raise exception if guards are created anonymously (void context)
+ (thanks Tim Bunce and Graham Knop)
0.12 Fri Mar 26 19:12:11 2010
- fix link in README (thanks Franck Joncourt)
@@ -7,7 +11,7 @@
- doc tweak
0.10 Thu Mar 25 20:14:25 2010
- - add guard() and scope_guard() - thanks Tim Bunce
+ - add guard() and scope_guard() (thanks Tim Bunce)
0.03 Sun Jan 7 19:19:17 2007
- POD fix (thanks Craig Manley)
Modified: trunk/libscope-guard-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/MANIFEST?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/MANIFEST (original)
+++ trunk/libscope-guard-perl/MANIFEST Mon May 17 02:34:31 2010
@@ -6,6 +6,4 @@
README
t/guard.t
t/new.t
-t/pod.t
-t/pod_coverage.t
t/scope_guard.t
Modified: trunk/libscope-guard-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/META.yml?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/META.yml (original)
+++ trunk/libscope-guard-perl/META.yml Mon May 17 02:34:31 2010
@@ -1,20 +1,22 @@
--- #YAML:1.0
name: Scope-Guard
-version: 0.12
+version: 0.20
abstract: lexically-scoped resource management
author:
- chocolateboy <chocolate at cpan.org>
-license: unknown
+license: perl
distribution_type: module
configure_requires:
ExtUtils::MakeMaker: 0
+build_requires:
+ Test::More: 0
requires:
- Test::More: 0
+ perl: 5.006001
no_index:
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.48
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libscope-guard-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/Makefile.PL?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/Makefile.PL (original)
+++ trunk/libscope-guard-perl/Makefile.PL Mon May 17 02:34:31 2010
@@ -5,13 +5,33 @@
use ExtUtils::MakeMaker;
-WriteMakefile(
- NAME => 'Scope::Guard',
- VERSION_FROM => 'lib/Scope/Guard.pm', # finds $VERSION
- PREREQ_PM => {
- 'Test::More' => 0,
+WriteMakefile1(
+ MIN_PERL_VERSION => '5.006001',
+ BUILD_REQUIRES => {
+ 'Test::More' => 0,
},
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'lib/Scope/Guard.pm', # retrieve abstract from module
- AUTHOR => 'chocolateboy <chocolate at cpan.org>') : ()),
+ NAME => 'Scope::Guard',
+ VERSION_FROM => 'lib/Scope/Guard.pm',
+ ABSTRACT_FROM => 'lib/Scope/Guard.pm',
+ AUTHOR => 'chocolateboy <chocolate at cpan.org>',
+ LICENSE => 'perl'
);
+
+sub WriteMakefile1 { # Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade.
+ my %params = @_;
+ my $eumm_version = $ExtUtils::MakeMaker::VERSION;
+ $eumm_version = eval $eumm_version;
+ die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
+ die "License not specified" if not exists $params{LICENSE};
+ if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
+ # EUMM 6.5502 has problems with BUILD_REQUIRES
+ $params{PREREQ_PM} = { %{ $params{PREREQ_PM} || {} }, %{ $params{BUILD_REQUIRES} } };
+ delete $params{BUILD_REQUIRES};
+ }
+ delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
+ delete $params{LICENSE} if $eumm_version < 6.31;
+ delete $params{AUTHOR} if $] < 5.005;
+ delete $params{ABSTRACT_FROM} if $] < 5.005;
+
+ WriteMakefile(%params);
+}
Modified: trunk/libscope-guard-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/README?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/README (original)
+++ trunk/libscope-guard-perl/README Mon May 17 02:34:31 2010
@@ -1,4 +1,4 @@
-Scope-Guard version 0.12
+Scope-Guard version 0.20
========================
This module provides a convenient way to perform cleanup or other forms of resource
Modified: trunk/libscope-guard-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/debian/changelog?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/debian/changelog (original)
+++ trunk/libscope-guard-perl/debian/changelog Mon May 17 02:34:31 2010
@@ -1,3 +1,12 @@
+libscope-guard-perl (0.20-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Add myself to Copyright and Uploaders
+ * Rewrite control description
+ * Pod and Coverage tests have been removed, per upstream
+
+ -- Jonathan Yu <jawnsy at cpan.org> Sun, 16 May 2010 23:12:56 -0400
+
libscope-guard-perl (0.12-1) unstable; urgency=low
[ gregor herrmann ]
Modified: trunk/libscope-guard-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/debian/control?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/debian/control (original)
+++ trunk/libscope-guard-perl/debian/control Mon May 17 02:34:31 2010
@@ -2,13 +2,12 @@
Section: perl
Priority: optional
Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl, libtest-pod-perl,
- libtest-pod-coverage-perl
+Build-Depends-Indep: perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Krzysztof Krzyzaniak (eloy) <eloy at debian.org>,
gregor herrmann <gregoa at debian.org>,
Ansgar Burchardt <ansgar at 43-1.org>,
- Franck Joncourt <franck at debian.org>
+ Franck Joncourt <franck at debian.org>, Jonathan Yu <jawnsy at cpan.org>
Standards-Version: 3.8.4
Homepage: http://search.cpan.org/dist/Scope-Guard/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libscope-guard-perl/
@@ -16,15 +15,10 @@
Package: libscope-guard-perl
Architecture: all
-Depends: ${perl:Depends}, ${misc:Depends},
+Depends: ${perl:Depends}, ${misc:Depends}
Description: lexically scoped resource management
- Scope::Guear provides a convenient way to perform cleanup or other forms of
- resource management at the end of a scope. It is particularly useful when
- dealing with exceptions.
- The Scope::Guard constructor takes a reference to a subroutine that is
- guaranteed to be called even if the thread of execution is aborted prematurely.
- This effectively allows lexically-scoped "promises" to be made that are
- automatically honoured by perl's garbage collector.
+ Scope::Guard is a Perl module that provides a convenient way to perform
+ cleanup or other forms of resource management at the end of a scope. It is
+ particularly useful when dealing with exceptions.
.
- For more information, see:
- http://www.drdobbs.com/cpp/184403758
+ For more information, see: <URL:http://www.drdobbs.com/cpp/184403758>
Modified: trunk/libscope-guard-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/debian/copyright?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/debian/copyright (original)
+++ trunk/libscope-guard-perl/debian/copyright Mon May 17 02:34:31 2010
@@ -8,10 +8,11 @@
License: Artistic or GPL-1+
Files: debian/*
-Copyright: 2007, Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
+Copyright: 2010, Ansgar Burchardt <ansgar at 43-1.org>
+ 2010, Franck Joncourt <franck at debian.org>
+ 2010, Jonathan Yu <jawnsy at cpan.org>
2008, gregor herrmann <gregor+debian at comodo.priv.at>
- 2010, Ansgar Burchardt <ansgar at 43-1.org>
- 2010, Franck Joncourt <franck at debian.org>
+ 2007, Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
License: Artistic or GPL-1+
License: Artistic
Modified: trunk/libscope-guard-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/debian/rules?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/debian/rules (original)
+++ trunk/libscope-guard-perl/debian/rules Mon May 17 02:34:31 2010
@@ -1,3 +1,4 @@
#!/usr/bin/make -f
+
%:
dh $@
Modified: trunk/libscope-guard-perl/lib/Scope/Guard.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/lib/Scope/Guard.pm?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/lib/Scope/Guard.pm (original)
+++ trunk/libscope-guard-perl/lib/Scope/Guard.pm Mon May 17 02:34:31 2010
@@ -3,19 +3,22 @@
use strict;
use warnings;
+use Carp qw(confess);
use Exporter ();
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(guard scope_guard);
-our $VERSION = '0.12';
+our $VERSION = '0.20';
sub new {
+ confess "Can't create a Scope::Guard in void context" unless (defined wantarray);
+
my $class = shift;
my $handler = shift() || die 'Scope::Guard::new: no handler supplied';
my $ref = ref $handler || '';
die "Scope::Guard::new: invalid handler - expected CODE ref, got: '$ref'"
- unless (UNIVERSAL::isa($handler, 'CODE'));
+ unless (UNIVERSAL::isa($handler, 'CODE'));
bless [ 0, $handler ], ref $class || $class;
}
@@ -57,7 +60,7 @@
# or
- my $guard = Scope::Guard->new(\&handler);
+ my $guard = Scope::Guard->new(sub { ... });
$guard->dismiss(); # disable the handler
@@ -113,19 +116,9 @@
my $guard = guard { ... };
-- or it can be called in void context to create a guard for the current scope e.g.
-
- guard { ... };
-
-Because there is no way to dismiss the guard in the latter case, it is assumed that
-the block knows how to deal with situations in which the resource has already been
-managed e.g.
-
- guard {
- if ($resource->locked) {
- $resource->unlock;
- }
- };
+Note: calling C<guard> anonymously, i.e. in void context, will raise an exception.
+This is because anonymous guards are destroyed B<immediately>
+(rather than at the end of the scope), which is unlikely to be the desired behaviour.
=head2 scope_guard
@@ -142,11 +135,11 @@
my $guard = scope_guard $handler;
-Like C<guard>, it can be called in void context to install an anonymous guard in the current scope.
+As with C<guard>, calling C<scope_guard> in void context will raise an exception.
=head1 VERSION
-0.12
+0.20
=head1 SEE ALSO
@@ -165,6 +158,8 @@
=item * L<Perl::AtEndOfScope|Perl::AtEndOfScope>
=item * L<ReleaseAction|ReleaseAction>
+
+=item * L<Scope::local_OnExit|Scope::local_OnExit>
=item * L<Scope::OnExit|Scope::OnExit>
Modified: trunk/libscope-guard-perl/t/guard.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/t/guard.t?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/t/guard.t (original)
+++ trunk/libscope-guard-perl/t/guard.t Mon May 17 02:34:31 2010
@@ -1,47 +1,116 @@
#!/usr/bin/env perl
+
+# XXX Test::Exception...
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 18;
BEGIN { use_ok('Scope::Guard', 'guard') };
-my $i = 1;
+my $test_0 = 'test_0';
+my $test_1 = 'test_1';
+my $test_2 = 'test_2';
+
+eval {
+ $test_0 = 'modified test_0';
+ guard { $test_1 = 'modified test_1' }; # void context: blow up
+ $test_2 = 'modified test_2'; # not reached
+};
+
+like $@, qr{Can't create a Scope::Guard in void context};
+is $test_0, 'modified test_0';
+is $test_1, 'test_1';
+is $test_2, 'test_2';
+
+####################################################
+
+my $test_3 = 'test_3';
+my $test_4 = 'test_4';
+
+sub {
+ my $guard = guard { $test_3 = 'modified test_3' };
+ return;
+ $test_4 = 'modified test 4';
+}->();
+
+is $test_3, 'modified test_3';
+is $test_4, 'test_4';
+
+####################################################
+
+my $test_5 = 'test_5';
+my $test_6 = 'test_6';
+
+eval {
+ my $guard = guard { $test_5 = 'modified test_5' };
+
+ my $numerator = 42;
+ my $denominator = 0;
+ my $exception = $numerator / $denominator;
+
+ $test_6 = 'modified test 3'; # not reached
+};
+
+like $@, qr{^Illegal division by zero};
+is $test_5, 'modified test_5';
+is $test_6, 'test_6';
+
+####################################################
+
+my $test_7 = 'test_7';
+my $test_8 = 'test_8';
{
- guard { ok($i++ == 1, 'handler invoked at scope end') };
+ my $guard = guard { $test_7 = 'modified test_7' }; # not called (due to dismiss())
+ $guard->dismiss(); # defaults to true
+ $test_8 = 'modified test_8'; # reached!
}
-sub {
- guard { ok($i++ == 2, 'handler invoked on return') };
- return;
-}->();
+is $test_7, 'test_7'; # unmodified
+is $test_8, 'modified test_8'; # the guard was dismissed, so this is reached
-eval {
- guard { ok($i++ == 3, 'handler invoked on exception') };
- my $j = 0;
- my $k = $j / $j;
-};
+####################################################
-like($@, qr{^Illegal division by zero}, 'exception was raised');
+my $test_9 = 'test_9';
+my $test_10 = 'test_10';
{
- my $guard = guard { ++$i };
- $guard->dismiss();
+ my $guard = guard { $test_9 = 'modified test_9' }; # not called (due to dismiss())
+ $guard->dismiss(1);
+ $test_10 = 'modified test_10'; # reached!
}
-ok($i++ == 4, 'dismiss() disables handler');
+is $test_9, 'test_9';
+is $test_10, 'modified test_10';
+
+####################################################
+
+my $test_11 = 'test_11';
+my $test_12 = 'test_12';
{
- my $guard = guard { ++$i };
- $guard->dismiss(1);
+ my $guard = guard { $test_11 = 'modified test_11' };
+ $guard->dismiss(); # dismiss: default argument (1)
+ $guard->dismiss(0); # un-dismiss!
+ $test_12 = 'modified test_12';
}
-ok($i++ == 5, 'dismiss(1) disables handler');
+is $test_11, 'modified test_11';
+is $test_12, 'modified test_12';
+
+####################################################
+
+my $test_13 = 'test_13';
+my $test_14 = 'test_14';
{
- my $guard = guard { ok($i++ == 6, 'dismiss(0) enables handler') };
- $guard->dismiss();
- $guard->dismiss(0);
+ my $guard = guard { $test_13 = 'modified test_13' };
+ $guard->dismiss(1); # dismiss: explicit argument (1)
+ $guard->dismiss(0); # un-dismiss!
+ $test_14 = 'modified test_14';
}
+
+is $test_13, 'modified test_13';
+is $test_14, 'modified test_14';
Modified: trunk/libscope-guard-perl/t/new.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/t/new.t?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/t/new.t (original)
+++ trunk/libscope-guard-perl/t/new.t Mon May 17 02:34:31 2010
@@ -1,52 +1,116 @@
#!/usr/bin/env perl
+
+# XXX Test::Exception...
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 18;
-BEGIN { use_ok('Scope::Guard') };
+BEGIN { use_ok('Scope::Guard', 'scope_guard') };
-my $i = 1;
+my $test_0 = 'test_0';
+my $test_1 = 'test_1';
+my $test_2 = 'test_2';
-sub handler {
- ok($i++ == 3, 'handler invoked on exception');
+eval {
+ $test_0 = 'modified test_0';
+ Scope::Guard->new(sub { $test_1 = 'modified test_1' }); # void context: blow up
+ $test_2 = 'modified test_2'; # not reached
+};
+
+like $@, qr{Can't create a Scope::Guard in void context};
+is $test_0, 'modified test_0';
+is $test_1, 'test_1';
+is $test_2, 'test_2';
+
+####################################################
+
+my $test_3 = 'test_3';
+my $test_4 = 'test_4';
+
+sub {
+ my $guard = Scope::Guard->new(sub { $test_3 = 'modified test_3' });
+ return;
+ $test_4 = 'modified test 4';
+}->();
+
+is $test_3, 'modified test_3';
+is $test_4, 'test_4';
+
+####################################################
+
+my $test_5 = 'test_5';
+my $test_6 = 'test_6';
+
+eval {
+ my $guard = Scope::Guard->new(sub { $test_5 = 'modified test_5' });
+
+ my $numerator = 42;
+ my $denominator = 0;
+ my $exception = $numerator / $denominator;
+
+ $test_6 = 'modified test 3'; # not reached
+};
+
+like $@, qr{^Illegal division by zero};
+is $test_5, 'modified test_5';
+is $test_6, 'test_6';
+
+####################################################
+
+my $test_7 = 'test_7';
+my $test_8 = 'test_8';
+
+{
+ my $guard = Scope::Guard->new(sub { $test_7 = 'modified test_7' }); # not called (due to dismiss())
+ $guard->dismiss(); # defaults to true
+ $test_8 = 'modified test_8'; # reached!
}
+is $test_7, 'test_7'; # unmodified
+is $test_8, 'modified test_8'; # the guard was dismissed, so this is reached
+
+####################################################
+
+my $test_9 = 'test_9';
+my $test_10 = 'test_10';
+
{
- my $guard = Scope::Guard->new(sub { ok($i++ == 1, 'handler invoked at scope end') });
+ my $guard = Scope::Guard->new(sub { $test_9 = 'modified test_9' }); # not called (due to dismiss())
+ $guard->dismiss(1);
+ $test_10 = 'modified test_10'; # reached!
}
-sub {
- my $handler = sub { ok($i++ == 2, 'handler invoked on return') };
- my $guard = Scope::Guard->new($handler);
- return;
-}->();
+is $test_9, 'test_9';
+is $test_10, 'modified test_10';
-eval {
- my $guard = Scope::Guard->new(\&handler);
- my $j = 0;
- my $k = $j / $j;
-};
+####################################################
-like($@, qr{^Illegal division by zero}, 'exception was raised');
+my $test_11 = 'test_11';
+my $test_12 = 'test_12';
{
- my $guard = Scope::Guard->new(sub { ++$i });
- $guard->dismiss();
+ my $guard = Scope::Guard->new(sub { $test_11 = 'modified test_11' });
+ $guard->dismiss(); # dismiss: default argument (1)
+ $guard->dismiss(0); # un-dismiss!
+ $test_12 = 'modified test_12';
}
-ok($i++ == 4, 'dismiss() disables handler');
+is $test_11, 'modified test_11';
+is $test_12, 'modified test_12';
+
+####################################################
+
+my $test_13 = 'test_13';
+my $test_14 = 'test_14';
{
- my $guard = Scope::Guard->new(sub { ++$i });
- $guard->dismiss(1);
+ my $guard = Scope::Guard->new(sub { $test_13 = 'modified test_13' });
+ $guard->dismiss(1); # dismiss: explicit argument (1)
+ $guard->dismiss(0); # un-dismiss!
+ $test_14 = 'modified test_14';
}
-ok($i++ == 5, 'dismiss(1) disables handler');
-
-{
- my $guard = Scope::Guard->new(sub { ok($i++ == 6, 'dismiss(0) enables handler') });
- $guard->dismiss();
- $guard->dismiss(0);
-}
+is $test_13, 'modified test_13';
+is $test_14, 'modified test_14';
Modified: trunk/libscope-guard-perl/t/scope_guard.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscope-guard-perl/t/scope_guard.t?rev=57997&op=diff
==============================================================================
--- trunk/libscope-guard-perl/t/scope_guard.t (original)
+++ trunk/libscope-guard-perl/t/scope_guard.t Mon May 17 02:34:31 2010
@@ -1,52 +1,116 @@
#!/usr/bin/env perl
+
+# XXX Test::Exception...
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 18;
BEGIN { use_ok('Scope::Guard', 'scope_guard') };
-my $i = 1;
+my $test_0 = 'test_0';
+my $test_1 = 'test_1';
+my $test_2 = 'test_2';
-sub handler {
- ok($i++ == 3, 'handler invoked on exception');
+eval {
+ $test_0 = 'modified test_0';
+ scope_guard sub { $test_1 = 'modified test_1' }; # void context: blow up
+ $test_2 = 'modified test_2'; # not reached
+};
+
+like $@, qr{Can't create a Scope::Guard in void context};
+is $test_0, 'modified test_0';
+is $test_1, 'test_1';
+is $test_2, 'test_2';
+
+####################################################
+
+my $test_3 = 'test_3';
+my $test_4 = 'test_4';
+
+sub {
+ my $guard = scope_guard sub { $test_3 = 'modified test_3' };
+ return;
+ $test_4 = 'modified test 4';
+}->();
+
+is $test_3, 'modified test_3';
+is $test_4, 'test_4';
+
+####################################################
+
+my $test_5 = 'test_5';
+my $test_6 = 'test_6';
+
+eval {
+ my $guard = scope_guard sub { $test_5 = 'modified test_5' };
+
+ my $numerator = 42;
+ my $denominator = 0;
+ my $exception = $numerator / $denominator;
+
+ $test_6 = 'modified test 3'; # not reached
+};
+
+like $@, qr{^Illegal division by zero};
+is $test_5, 'modified test_5';
+is $test_6, 'test_6';
+
+####################################################
+
+my $test_7 = 'test_7';
+my $test_8 = 'test_8';
+
+{
+ my $guard = scope_guard sub { $test_7 = 'modified test_7' }; # not called (due to dismiss())
+ $guard->dismiss(); # defaults to true
+ $test_8 = 'modified test_8'; # reached!
}
+is $test_7, 'test_7'; # unmodified
+is $test_8, 'modified test_8'; # the guard was dismissed, so this is reached
+
+####################################################
+
+my $test_9 = 'test_9';
+my $test_10 = 'test_10';
+
{
- scope_guard sub { ok($i++ == 1, 'handler invoked at scope end') };
+ my $guard = scope_guard sub { $test_9 = 'modified test_9' }; # not called (due to dismiss())
+ $guard->dismiss(1);
+ $test_10 = 'modified test_10'; # reached!
}
-sub {
- my $handler = sub { ok($i++ == 2, 'handler invoked on return') };
- scope_guard $handler;
- return;
-}->();
+is $test_9, 'test_9';
+is $test_10, 'modified test_10';
-eval {
- scope_guard \&handler;
- my $j = 0;
- my $k = $j / $j;
-};
+####################################################
-like($@, qr{^Illegal division by zero}, 'exception was raised');
+my $test_11 = 'test_11';
+my $test_12 = 'test_12';
{
- my $guard = scope_guard sub { ++$i };
- $guard->dismiss();
+ my $guard = scope_guard sub { $test_11 = 'modified test_11' };
+ $guard->dismiss(); # dismiss: default argument (1)
+ $guard->dismiss(0); # un-dismiss!
+ $test_12 = 'modified test_12';
}
-ok($i++ == 4, 'dismiss() disables handler');
+is $test_11, 'modified test_11';
+is $test_12, 'modified test_12';
+
+####################################################
+
+my $test_13 = 'test_13';
+my $test_14 = 'test_14';
{
- my $guard = scope_guard sub { ++$i };
- $guard->dismiss(1);
+ my $guard = scope_guard sub { $test_13 = 'modified test_13' };
+ $guard->dismiss(1); # dismiss: explicit argument (1)
+ $guard->dismiss(0); # un-dismiss!
+ $test_14 = 'modified test_14';
}
-ok($i++ == 5, 'dismiss(1) disables handler');
-
-{
- my $guard = scope_guard sub { ok($i++ == 6, 'dismiss(0) enables handler') };
- $guard->dismiss();
- $guard->dismiss(0);
-}
+is $test_13, 'modified test_13';
+is $test_14, 'modified test_14';
More information about the Pkg-perl-cvs-commits
mailing list