r39686 - in /branches/upstream/libguard-perl: ./ current/ current/t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Jul 11 02:46:08 UTC 2009
Author: jawnsy-guest
Date: Sat Jul 11 02:46:00 2009
New Revision: 39686
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39686
Log:
[svn-inject] Installing original source of libguard-perl
Added:
branches/upstream/libguard-perl/
branches/upstream/libguard-perl/current/
branches/upstream/libguard-perl/current/COPYING
branches/upstream/libguard-perl/current/Changes
branches/upstream/libguard-perl/current/Guard.pm
branches/upstream/libguard-perl/current/Guard.xs
branches/upstream/libguard-perl/current/MANIFEST
branches/upstream/libguard-perl/current/META.yml
branches/upstream/libguard-perl/current/Makefile.PL
branches/upstream/libguard-perl/current/README
branches/upstream/libguard-perl/current/t/
branches/upstream/libguard-perl/current/t/00_load.t
branches/upstream/libguard-perl/current/t/01_scoped.t
branches/upstream/libguard-perl/current/t/02_guard.t
branches/upstream/libguard-perl/current/t/03_die.t
Added: branches/upstream/libguard-perl/current/COPYING
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/COPYING?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/COPYING (added)
+++ branches/upstream/libguard-perl/current/COPYING Sat Jul 11 02:46:00 2009
@@ -1,0 +1,2 @@
+This module is licensed under the same terms as perl itself.
+
Added: branches/upstream/libguard-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/Changes?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/Changes (added)
+++ branches/upstream/libguard-perl/current/Changes Sat Jul 11 02:46:00 2009
@@ -1,0 +1,32 @@
+Revision history for Perl extension Guard
+
+1.02 Sat Apr 11 06:42:06 CEST 2009
+ - set NODEBUG on scope_guard, to work around -d: modules
+ causing scope_guard to be called in the wrong context.
+
+1.01 Wed Jan 14 00:30:18 CET 2009
+ - guard_free didn't return a value.
+
+1.0 Fri Dec 26 14:03:28 CET 2008
+ - un-support windows process emulation (it didn't
+ work anyways).
+ - discuss similar modules.
+ - tweaked documentation slightly.
+
+0.5 Sat Dec 13 22:46:46 CET 2008
+ - vastly improve documentation,
+ clarify local/scope_guard ordering
+ and give a niftier examples.
+ - always bless guard objects and convert
+ Guard::cancel to a method, at an 8% runtime
+ cost.
+ - temporarily disable $SIG{__DIE__} when executing
+ guard blocks.
+ - fix testsuite.
+
+0.1 Sat Dec 13 18:49:30 CET 2008
+ - first release.
+
+0.01 Sat Dec 13 14:57:44 CET 2008
+ - cloned form Convert-Scalar.
+
Added: branches/upstream/libguard-perl/current/Guard.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/Guard.pm?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/Guard.pm (added)
+++ branches/upstream/libguard-perl/current/Guard.pm Sat Jul 11 02:46:00 2009
@@ -1,0 +1,204 @@
+=head1 NAME
+
+Guard - safe cleanup blocks
+
+=head1 SYNOPSIS
+
+ use Guard;
+
+ # temporarily chdir to "/etc" directory, but make sure
+ # to go back to "/" no matter how myfun exits:
+ sub myfun {
+ scope_guard { chdir "/" };
+ chdir "/etc";
+
+ code_that_might_die_or_does_other_fun_stuff;
+ }
+
+=head1 DESCRIPTION
+
+This module implements so-called "guards". A guard is something (usually
+an object) that "guards" a resource, ensuring that it is cleaned up when
+expected.
+
+Specifically, this module supports two different types of guards: guard
+objects, which execute a given code block when destroyed, and scoped
+guards, which are tied to the scope exit.
+
+=head1 FUNCTIONS
+
+This module currently exports the C<scope_guard> and C<guard> functions by
+default.
+
+=over 4
+
+=cut
+
+package Guard;
+
+no warnings;
+
+BEGIN {
+ $VERSION = '1.02';
+ @ISA = qw(Exporter);
+ @EXPORT = qw(guard scope_guard);
+
+ require Exporter;
+
+ require XSLoader;
+ XSLoader::load Guard, $VERSION;
+}
+
+our $DIED = sub { warn "$@" };
+
+=item scope_guard BLOCK
+
+Registers a block that is executed when the current scope (block,
+function, method, eval etc.) is exited.
+
+See the EXCEPTIONS section for an explanation of how exceptions
+(i.e. C<die>) are handled inside guard blocks.
+
+The description below sounds a bit complicated, but that's just because
+C<scope_guard> tries to get even corner cases "right": the goal is to
+provide you with a rock solid clean up tool.
+
+The behaviour is similar to this code fragment:
+
+ eval ... code following scope_guard ...
+ {
+ local $@;
+ eval BLOCK;
+ eval { $Guard::DIED->() } if $@;
+ }
+ die if $@;
+
+Except it is much faster, and the whole thing gets executed even when the
+BLOCK calls C<exit>, C<goto>, C<last> or escapes via other means.
+
+If multiple BLOCKs are registered to the same scope, they will be executed
+in reverse order. Other scope-related things such as C<local> are managed
+via the same mechanism, so variables C<local>ised I<after> calling
+C<scope_guard> will be restored when the guard runs.
+
+Example: temporarily change the timezone for the current process,
+ensuring it will be reset when the C<if> scope is exited:
+
+ use Guard;
+ use POSIX ();
+
+ if ($need_to_switch_tz) {
+ # make sure we call tzset after $ENV{TZ} has been restored
+ scope_guard { POSIX::tzset };
+
+ # localise after the scope_guard, so it gets undone in time
+ local $ENV{TZ} = "Europe/London";
+ POSIX::tzset;
+
+ # do something with the new timezone
+ }
+
+=item my $guard = guard BLOCK
+
+Behaves the same as C<scope_guard>, except that instead of executing
+the block on scope exit, it returns an object whose lifetime determines
+when the BLOCK gets executed: when the last reference to the object gets
+destroyed, the BLOCK gets executed as with C<scope_guard>.
+
+The returned object can be copied as many times as you want.
+
+See the EXCEPTIONS section for an explanation of how exceptions
+(i.e. C<die>) are handled inside guard blocks.
+
+Example: acquire a Coro::Semaphore for a second by registering a
+timer. The timer callback references the guard used to unlock it
+again. (Please ignore the fact that C<Coro::Semaphore> has a C<guard>
+method that does this already):
+
+ use Guard;
+ use AnyEvent;
+ use Coro::Semaphore;
+
+ my $sem = new Coro::Semaphore;
+
+ sub lock_for_a_second {
+ $sem->down;
+ my $guard = guard { $sem->up };
+
+ my $timer;
+ $timer = AnyEvent->timer (after => 1, sub {
+ # do something
+ undef $sem;
+ undef $timer;
+ });
+ }
+
+The advantage of doing this with a guard instead of simply calling C<<
+$sem->down >> in the callback is that you can opt not to create the timer,
+or your code can throw an exception before it can create the timer, or you
+can create multiple timers or other event watchers and only when the last
+one gets executed will the lock be unlocked. Using the C<guard>, you do
+not have to worry about catching all the places where you have to unlock
+the semaphore.
+
+=item $guard->cancel
+
+Calling this function will "disable" the guard object returned by the
+C<guard> function, i.e. it will free the BLOCK originally passed to
+C<guard >and will arrange for the BLOCK not to be executed.
+
+This can be useful when you use C<guard> to create a fatal cleanup handler
+and later decide it is no longer needed.
+
+=cut
+
+1;
+
+=back
+
+=head1 EXCEPTIONS
+
+Guard blocks should not normally throw exceptions (that is, C<die>). After
+all, they are usually used to clean up after such exceptions. However, if
+something truly exceptional is happening, a guard block should be allowed
+to die. Also, programming errors are a large source of exceptions, and the
+programmer certainly wants to know about those.
+
+Since in most cases, the block executing when the guard gets executed does
+not know or does not care about the guard blocks, it makes little sense to
+let containing code handle the exception.
+
+Therefore, whenever a guard block throws an exception, it will be caught,
+followed by calling the code reference stored in C<$Guard::DIED> (with
+C<$@> set to the actual exception), which is similar to how most event
+loops handle this case.
+
+The default for C<$Guard::DIED> is to call C<warn "$@">.
+
+The C<$@> variable will be restored to its value before the guard call in
+all cases, so guards will not disturb C<$@> in any way.
+
+The code reference stored in C<$Guard::DIED> should not die (behaviour is
+not guaranteed, but right now, the exception will simply be ignored).
+
+=head1 AUTHOR
+
+ Marc Lehmann <schmorp at schmorp.de>
+ http://home.schmorp.de/
+
+=head1 THANKS
+
+Thanks to Marco Maisenhelder, who reminded me of the C<$Guard::DIED>
+solution to the problem of exceptions.
+
+=head1 SEE ALSO
+
+L<Scope::Guard> and L<Sub::ScopeFinalizer>, which actually implement
+dynamic, not scoped guards, and have a lot higher CPU, memory and typing
+overhead.
+
+L<Hook::Scope>, which has apparently never been finished and corrupts
+memory when used.
+
+=cut
+
Added: branches/upstream/libguard-perl/current/Guard.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/Guard.xs?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/Guard.xs (added)
+++ branches/upstream/libguard-perl/current/Guard.xs Sat Jul 11 02:46:00 2009
@@ -1,0 +1,124 @@
+#define PERL_NO_GET_CONTEXT
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static HV *guard_stash;
+
+static SV *
+guard_get_cv (pTHX_ SV *cb_sv)
+{
+ HV *st;
+ GV *gvp;
+ CV *cv = sv_2cv (cb_sv, &st, &gvp, 0);
+
+ if (!cv)
+ croak ("expected a CODE reference for guard");
+
+ return (SV *)cv;
+}
+
+static void
+exec_guard_cb (pTHX_ SV *cb)
+{
+ dSP;
+ SV *saveerr = SvOK (ERRSV) ? sv_mortalcopy (ERRSV) : 0;
+ SV *savedie = PL_diehook;
+
+ PL_diehook = 0;
+
+ PUSHSTACKi (PERLSI_DESTROY);
+
+ PUSHMARK (SP);
+ PUTBACK;
+ call_sv (cb, G_VOID | G_DISCARD | G_EVAL);
+
+ if (SvTRUE (ERRSV))
+ {
+ SPAGAIN;
+
+ PUSHMARK (SP);
+ PUTBACK;
+ call_sv (get_sv ("Guard::DIED", 1), G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
+
+ sv_setpvn (ERRSV, "", 0);
+ }
+
+ if (saveerr)
+ sv_setsv (ERRSV, saveerr);
+
+ {
+ SV *oldhook = PL_diehook;
+ PL_diehook = savedie;
+ SvREFCNT_dec (oldhook);
+ }
+
+ POPSTACK;
+}
+
+static void
+scope_guard_cb (pTHX_ void *cv)
+{
+ exec_guard_cb (aTHX_ sv_2mortal ((SV *)cv));
+}
+
+static int
+guard_free (pTHX_ SV *cv, MAGIC *mg)
+{
+ exec_guard_cb (aTHX_ mg->mg_obj);
+
+ return 0;
+}
+
+static MGVTBL guard_vtbl = {
+ 0, 0, 0, 0,
+ guard_free
+};
+
+MODULE = Guard PACKAGE = Guard
+
+BOOT:
+ guard_stash = gv_stashpv ("Guard", 1);
+ CvNODEBUG_on (get_cv ("Guard::scope_guard", 0)); /* otherwise calling scope can be the debugger */
+
+void
+scope_guard (SV *block)
+ PROTOTYPE: &
+ CODE:
+ LEAVE; /* unfortunately, perl sandwiches XS calls into ENTER/LEAVE */
+ SAVEDESTRUCTOR_X (scope_guard_cb, (void *)SvREFCNT_inc (guard_get_cv (aTHX_ block)));
+ ENTER; /* unfortunately, perl sandwiches XS calls into ENTER/LEAVE */
+
+SV *
+guard (SV *block)
+ PROTOTYPE: &
+ CODE:
+{
+ SV *cv = guard_get_cv (aTHX_ block);
+ SV *guard = NEWSV (0, 0);
+ SvUPGRADE (guard, SVt_PVMG);
+ sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0);
+ RETVAL = newRV_noinc (guard);
+ SvOBJECT_on (guard);
+ ++PL_sv_objcount;
+ SvSTASH_set (guard, (HV*)SvREFCNT_inc ((SV *)guard_stash));
+}
+ OUTPUT:
+ RETVAL
+
+void
+cancel (SV *guard)
+ PROTOTYPE: $
+ CODE:
+{
+ MAGIC *mg;
+ if (!SvROK (guard)
+ || !(mg = mg_find (SvRV (guard), PERL_MAGIC_ext))
+ || mg->mg_virtual != &guard_vtbl)
+ croak ("Guard::cancel called on a non-guard object");
+
+ SvREFCNT_dec (mg->mg_obj);
+ mg->mg_obj = 0;
+ mg->mg_virtual = 0;
+}
Added: branches/upstream/libguard-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/MANIFEST?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/MANIFEST (added)
+++ branches/upstream/libguard-perl/current/MANIFEST Sat Jul 11 02:46:00 2009
@@ -1,0 +1,12 @@
+README
+Changes
+MANIFEST
+COPYING
+Makefile.PL
+Guard.pm
+Guard.xs
+t/00_load.t
+t/01_scoped.t
+t/02_guard.t
+t/03_die.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libguard-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/META.yml?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/META.yml (added)
+++ branches/upstream/libguard-perl/current/META.yml Sat Jul 11 02:46:00 2009
@@ -1,0 +1,18 @@
+--- #YAML:1.0
+name: Guard
+version: 1.02
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.48
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Added: branches/upstream/libguard-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/Makefile.PL?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/Makefile.PL (added)
+++ branches/upstream/libguard-perl/current/Makefile.PL Sat Jul 11 02:46:00 2009
@@ -1,0 +1,14 @@
+use ExtUtils::MakeMaker;
+
+use 5.008;
+
+WriteMakefile(
+ dist => {
+ PREOP => 'pod2text Guard.pm | tee README >$(DISTVNAME)/README; chmod -R u=rwX,go=rX . ;',
+ COMPRESS => 'gzip -9v',
+ SUFFIX => '.gz',
+ },
+ NAME => "Guard",
+ VERSION_FROM => "Guard.pm",
+);
+
Added: branches/upstream/libguard-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/README?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/README (added)
+++ branches/upstream/libguard-perl/current/README Sat Jul 11 02:46:00 2009
@@ -1,0 +1,166 @@
+NAME
+ Guard - safe cleanup blocks
+
+SYNOPSIS
+ use Guard;
+
+ # temporarily chdir to "/etc" directory, but make sure
+ # to go back to "/" no matter how myfun exits:
+ sub myfun {
+ scope_guard { chdir "/" };
+ chdir "/etc";
+
+ code_that_might_die_or_does_other_fun_stuff;
+ }
+
+DESCRIPTION
+ This module implements so-called "guards". A guard is something (usually
+ an object) that "guards" a resource, ensuring that it is cleaned up when
+ expected.
+
+ Specifically, this module supports two different types of guards: guard
+ objects, which execute a given code block when destroyed, and scoped
+ guards, which are tied to the scope exit.
+
+FUNCTIONS
+ This module currently exports the "scope_guard" and "guard" functions by
+ default.
+
+ scope_guard BLOCK
+ Registers a block that is executed when the current scope (block,
+ function, method, eval etc.) is exited.
+
+ See the EXCEPTIONS section for an explanation of how exceptions
+ (i.e. "die") are handled inside guard blocks.
+
+ The description below sounds a bit complicated, but that's just
+ because "scope_guard" tries to get even corner cases "right": the
+ goal is to provide you with a rock solid clean up tool.
+
+ The behaviour is similar to this code fragment:
+
+ eval ... code following scope_guard ...
+ {
+ local $@;
+ eval BLOCK;
+ eval { $Guard::DIED->() } if $@;
+ }
+ die if $@;
+
+ Except it is much faster, and the whole thing gets executed even
+ when the BLOCK calls "exit", "goto", "last" or escapes via other
+ means.
+
+ If multiple BLOCKs are registered to the same scope, they will be
+ executed in reverse order. Other scope-related things such as
+ "local" are managed via the same mechanism, so variables "local"ised
+ *after* calling "scope_guard" will be restored when the guard runs.
+
+ Example: temporarily change the timezone for the current process,
+ ensuring it will be reset when the "if" scope is exited:
+
+ use Guard;
+ use POSIX ();
+
+ if ($need_to_switch_tz) {
+ # make sure we call tzset after $ENV{TZ} has been restored
+ scope_guard { POSIX::tzset };
+
+ # localise after the scope_guard, so it gets undone in time
+ local $ENV{TZ} = "Europe/London";
+ POSIX::tzset;
+
+ # do something with the new timezone
+ }
+
+ my $guard = guard BLOCK
+ Behaves the same as "scope_guard", except that instead of executing
+ the block on scope exit, it returns an object whose lifetime
+ determines when the BLOCK gets executed: when the last reference to
+ the object gets destroyed, the BLOCK gets executed as with
+ "scope_guard".
+
+ The returned object can be copied as many times as you want.
+
+ See the EXCEPTIONS section for an explanation of how exceptions
+ (i.e. "die") are handled inside guard blocks.
+
+ Example: acquire a Coro::Semaphore for a second by registering a
+ timer. The timer callback references the guard used to unlock it
+ again. (Please ignore the fact that "Coro::Semaphore" has a "guard"
+ method that does this already):
+
+ use Guard;
+ use AnyEvent;
+ use Coro::Semaphore;
+
+ my $sem = new Coro::Semaphore;
+
+ sub lock_for_a_second {
+ $sem->down;
+ my $guard = guard { $sem->up };
+
+ my $timer;
+ $timer = AnyEvent->timer (after => 1, sub {
+ # do something
+ undef $sem;
+ undef $timer;
+ });
+ }
+
+ The advantage of doing this with a guard instead of simply calling
+ "$sem->down" in the callback is that you can opt not to create the
+ timer, or your code can throw an exception before it can create the
+ timer, or you can create multiple timers or other event watchers and
+ only when the last one gets executed will the lock be unlocked.
+ Using the "guard", you do not have to worry about catching all the
+ places where you have to unlock the semaphore.
+
+ $guard->cancel
+ Calling this function will "disable" the guard object returned by
+ the "guard" function, i.e. it will free the BLOCK originally passed
+ to "guard "and will arrange for the BLOCK not to be executed.
+
+ This can be useful when you use "guard" to create a fatal cleanup
+ handler and later decide it is no longer needed.
+
+EXCEPTIONS
+ Guard blocks should not normally throw exceptions (that is, "die").
+ After all, they are usually used to clean up after such exceptions.
+ However, if something truly exceptional is happening, a guard block
+ should be allowed to die. Also, programming errors are a large source of
+ exceptions, and the programmer certainly wants to know about those.
+
+ Since in most cases, the block executing when the guard gets executed
+ does not know or does not care about the guard blocks, it makes little
+ sense to let containing code handle the exception.
+
+ Therefore, whenever a guard block throws an exception, it will be
+ caught, followed by calling the code reference stored in $Guard::DIED
+ (with $@ set to the actual exception), which is similar to how most
+ event loops handle this case.
+
+ The default for $Guard::DIED is to call "warn "$@"".
+
+ The $@ variable will be restored to its value before the guard call in
+ all cases, so guards will not disturb $@ in any way.
+
+ The code reference stored in $Guard::DIED should not die (behaviour is
+ not guaranteed, but right now, the exception will simply be ignored).
+
+AUTHOR
+ Marc Lehmann <schmorp at schmorp.de>
+ http://home.schmorp.de/
+
+THANKS
+ Thanks to Marco Maisenhelder, who reminded me of the $Guard::DIED
+ solution to the problem of exceptions.
+
+SEE ALSO
+ Scope::Guard and Sub::ScopeFinalizer, which actually implement dynamic,
+ not scoped guards, and have a lot higher CPU, memory and typing
+ overhead.
+
+ Hook::Scope, which has apparently never been finished and corrupts
+ memory when used.
+
Added: branches/upstream/libguard-perl/current/t/00_load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/t/00_load.t?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/t/00_load.t (added)
+++ branches/upstream/libguard-perl/current/t/00_load.t Sat Jul 11 02:46:00 2009
@@ -1,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Guard;
+$loaded = 1;
+print "ok 1\n";
Added: branches/upstream/libguard-perl/current/t/01_scoped.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/t/01_scoped.t?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/t/01_scoped.t (added)
+++ branches/upstream/libguard-perl/current/t/01_scoped.t Sat Jul 11 02:46:00 2009
@@ -1,0 +1,35 @@
+BEGIN { $| = 1; print "1..10\n"; }
+
+use Guard;
+
+print "ok 1\n";
+
+our $global = 0;
+
+{
+ scope_guard {
+ print "ok 3\n"
+ };
+ local $global = 1;
+ print "ok 2\n";
+}
+
+print "ok 4\n";
+
+{
+ scope_guard { print "ok 6\n" };
+ print "ok 5\n";
+ last;
+}
+
+print "ok 7\n";
+
+{
+ scope_guard { print "ok 9\n" };
+ print "ok 8\n";
+ exit;
+}
+
+END {
+ print "ok 10\n";
+}
Added: branches/upstream/libguard-perl/current/t/02_guard.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/t/02_guard.t?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/t/02_guard.t (added)
+++ branches/upstream/libguard-perl/current/t/02_guard.t Sat Jul 11 02:46:00 2009
@@ -1,0 +1,33 @@
+BEGIN { $| = 1; print "1..11\n"; }
+
+use Guard;
+
+print "ok 1\n";
+
+{
+ my $guard = guard { print "ok 3\n" };
+ print "ok 2\n";
+}
+
+print "ok 4\n";
+
+{
+ my $guard = guard { print "not ok 6\n" };
+ print "ok 5\n";
+ $guard->cancel;
+}
+
+print "ok 6\n";
+
+{
+ my $guard = guard { print "ok 9\n" };
+ my $guard2 = $guard;
+ print "ok 7\n";
+ undef $guard;
+ print "ok 8\n";
+ undef $guard2;
+ print "ok 10\n";
+}
+
+print "ok 11\n";
+
Added: branches/upstream/libguard-perl/current/t/03_die.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libguard-perl/current/t/03_die.t?rev=39686&op=file
==============================================================================
--- branches/upstream/libguard-perl/current/t/03_die.t (added)
+++ branches/upstream/libguard-perl/current/t/03_die.t Sat Jul 11 02:46:00 2009
@@ -1,0 +1,54 @@
+BEGIN { $| = 1; print "1..11\n"; }
+
+use Guard;
+
+print "ok 1\n";
+
+$Guard::DIED = sub {
+ print $@ =~ /^x1 at / ? "" : "not ", "ok 3 # $@\n";
+};
+
+eval {
+ scope_guard { die "x1" };
+ print "ok 2\n";
+};
+
+print $@ ? "not " : "", "ok 4 # $@\n";
+
+$Guard::DIED = sub {
+ print $@ =~ /^x2 at / ? "" : "not ", "ok 6 # $@\n";
+};
+
+eval {
+ scope_guard { die "x2" };
+ print "ok 5\n";
+ die "x3";
+};
+
+print $@ =~ /^x3 at /s ? "" : "not ", "ok 7 # $@\n";
+
+our $x4 = 1;
+
+$SIG{__DIE__} = sub {
+ if ($x4) {
+ print "not ok 9\n";
+ } else {
+ print $_[0] =~ /^x5 at / ? "" : "not ", "ok 11 # $_[0]\n";
+ }
+ exit 0;
+};
+
+{
+ $Guard::DIED = sub {
+ print $@ =~ /^x4 at / ? "" : "not ", "ok 9 # $@\n";
+ };
+
+ scope_guard { die "x4" };
+ print "ok 8\n";
+};
+
+$x4 = 0;
+print "ok 10\n";
+
+die "x5";
+
More information about the Pkg-perl-cvs-commits
mailing list