r63597 - in /trunk/libtest-exception-perl: ./ debian/ debian/source/ lib/Test/ t/ t/developer/ xt/
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Mon Oct 11 13:01:00 UTC 2010
Author: ansgar
Date: Mon Oct 11 13:00:23 2010
New Revision: 63597
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=63597
Log:
* New upstream release.
* Use debhelper compat level 8 for Build.PL.
* Add build-dep on libmodule-build-perl >= 0.360000.
* Use source format 3.0 (quilt).
* debian/copyright: Refer to "Debian systems" instead of "Debian GNU/Linux
systems"; refer to /usr/share/common-licenses/GPL-1.
* Bump Standards-Version to 3.9.1.
* Add myself to Uploaders.
Added:
trunk/libtest-exception-perl/debian/source/
trunk/libtest-exception-perl/debian/source/format
trunk/libtest-exception-perl/xt/
- copied from r63596, branches/upstream/libtest-exception-perl/current/xt/
Removed:
trunk/libtest-exception-perl/t/developer/
Modified:
trunk/libtest-exception-perl/Changes
trunk/libtest-exception-perl/MANIFEST
trunk/libtest-exception-perl/META.yml
trunk/libtest-exception-perl/Makefile.PL
trunk/libtest-exception-perl/README
trunk/libtest-exception-perl/debian/changelog
trunk/libtest-exception-perl/debian/compat
trunk/libtest-exception-perl/debian/control
trunk/libtest-exception-perl/debian/copyright
trunk/libtest-exception-perl/lib/Test/Exception.pm
trunk/libtest-exception-perl/t/Exception.t
trunk/libtest-exception-perl/t/caller.t
trunk/libtest-exception-perl/t/stacktrace.t
Modified: trunk/libtest-exception-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/Changes?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/Changes (original)
+++ trunk/libtest-exception-perl/Changes Mon Oct 11 13:00:23 2010
@@ -1,17 +1,31 @@
Revision history for Perl extension Test::Exception:
-0.29
+0.31 [2010-10-10] Or the "Yay - an actual release!" release
+ - Same as 0.30_2
+
+0.30_2 [2010-10-06] Or the "oh what a to do" release
+ - Added a bunch of folk to the acknowledgements
+ - Added some clarifying documentation to respond to RT#59293
+ - Marked a test that was failing under T::B 2.0 until we figure out
+ whether it should pass or not. See http://is.gd/fNOFb
+
+0.30_1 [2010-10-04] Or the "Peter Rabbitson did all the work" release
+ - Added dates to changes file, as far as we can from backpan et al
+ - Fix for DB::args bug (thanks Peter Rabbitson)
+ - Fix for bizarre-copy bug (thanks Peter Rabbitson)
+
+0.29 [2010-01-11]
- Same as 0.28_01 - Many thanks to Ricardo Signes for doing all the work
getting this release out
-0.28_01
+0.28_01
- Patch to fix code with Sub::Uplevel again. Many thanks to David Golden
-0.27
+0.27 [2008-02-16]
- Patch to fix my broken code with the now working Sub::Uplevel. Many
thanks to David Golden
-0.26
+0.26 [2007-12-10]
- Added some more exposition on the usage of dies_ok() and lives_ok() for
those who found them confusing. Also reordered presentation of docs so
more specific throws_ok() comes first.
@@ -24,20 +38,20 @@
(thanks Peter Scott)
- Updated Test::* & Sub::Uplevel version dependencies to something modern
-0.25
+0.25 [2007-02-15]
- Updated Test::Simple dependency to make sure it is in sync with
the latest T::B::T (thanks David Cantrell)
-0.24
+0.24 [2006-10-07]
- Fixed a bunch of spelling mistakes in the POD
- Added an (optional) spelling test in t/developer
-0.23
+0.23 [2006-10-03]
- Added a bunch of missed acknowledgements
- Made the fact that $@ is preserved by T::E subroutines explicit in
the synopsis
-0.22 - or the "about bloody time" release
+0.22 - or the "about bloody time" release [2006-09-01]
- We now test that the import works (it does :-)
- Now works with exception classes that override isa
- Added link to AnnoCPAN
@@ -59,7 +73,7 @@
- Test coverage now at 100% (statement, branch, condition, subroutine
& POD) according to Devel::Cover 0.58
-0.21
+0.21 [2005-06-04]
- Most of build_requires should have been in requires, which was
causing CPANPLUS to choke on installs. Fixed (thanks Jos I. Boumans)
- Test names now called test descriptions to fit in with latest TAP
@@ -69,29 +83,29 @@
- Added description of how to use Test::Exception in a sub-passing non
prototype style (after feedback from Jim Keenan & Perrin)
-0.20
+0.20 [2004-08-27]
- fixed bug in lives_and where $Test::Builder::Level was
set to high if test in block lived
-0.19
+0.19 [2004-08-15]
- Added support for Module::Build
-0.18
+0.18 [2004-08-11]
- Cosmetic POD tweaks
- Added Test::Warn and Test::NoWarnings to SEE ALSO (thanks to
Andy Lester for pointing out the lack)
-0.17
+0.17 [2004-01-18]
- Tests now pass with Test::Simple 0.48
-0.16
+0.16 []
- pod.t now uses Test::Pod
- cleaned up code a little
- Fixed year in copyright in POD
- Added import() after suggestion from Peter Scott
- tidied tests a bit
-0.15
+0.15 [2003-01-28]
- Removed live() and added lives_and() after an excellent
suggestion from Aristotle
- Default name for throws_ok now has better output when passed
@@ -108,21 +122,21 @@
- Added live()
- Added default test name for throws_ok if no supplied
-0.13
+0.13 [2003-01-06]
- fixed MANIFEST and added MANIFEST.SKIP
- better output for lives_ok and throws_ok if exception classes
overload ""
- bug where it would fail if Test::Builder::ok ever threw
exceptions internally fixed.
-0.12 Mon Aug 26 2002 2002
+0.12 [2002-08-26]
- patched return.t so that it skips if we don't have a
Test::Harness that can handle TODO tests (thanks to
<chromatic at rmci.net> for pointing this out).
- tweaked POD and README
- Fixed prototypes
-0.11 Sat Jun 29 2002
+0.11 [2002-06-29]
- corrected README file
- refactored code a little
- minor tweaks to POD
@@ -130,7 +144,7 @@
(you couldn't regex an empty string - i.e. normal exit).
- Fixed bug.
-0.10 Sun Jun 2 2002
+0.10 [2002-06-02]
- Stopped over-exuberant pod.t and documented.t checking that
other peoples modules were documented and had legal POD!
- Couple of minor tweaks to the docs.
@@ -139,10 +153,10 @@
caller(). Much better than the regex hack added in 0.08 ---
which has now been removed.
-0.09 Sat Jun 1 2002
+0.09 [2002-06-01]
- Fixed poor English in throws_ok docs.
-0.08 Fri May 31 2002
+0.08 [2002-05-31]
- Added reference to Test::Inline to docs
- Test::More now in PREREQ_PM
- Culled some code that could never be called
@@ -154,7 +168,7 @@
exception can cause throws_ok to always succeed.
- Stopped stacktrace.t failing.
-0.07 Fri Apr 12 2002
+0.07 [2002-04-12]
- may_be_regex -> maybe_regex in Test::Builder
0.06
@@ -170,7 +184,7 @@
Mark Fowler for the suggestion and Michael G Schwern for adding
code to Test::Builder.
-0.03 Tue Apr 9 2002
+0.03 [2002-04-09]
- dies_ok, lives_ok & throws_ok now all return the result of the
underlying ok
- $@ is now guaranteed to be preserved (and is documented as
@@ -178,10 +192,9 @@
- Tests run tainted, strict & with warnings
(just to be on the safe side :-)
-0.02 Tue Apr 9 2002
+0.02 [2002-04-09]
- Documented properly
-0.01 Wed Mar 20 00:18:07 2002
+0.01 [2002-03-20]
- original version; created by h2xs 1.21 with options
-AX -n Test::Exception
-
Modified: trunk/libtest-exception-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/MANIFEST?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/MANIFEST (original)
+++ trunk/libtest-exception-perl/MANIFEST Mon Oct 11 13:00:23 2010
@@ -2,12 +2,8 @@
Changes
lib/Test/Exception.pm
MANIFEST This list of files
+README
t/caller.t
-t/developer/documented.t
-t/developer/perlcritic.t
-t/developer/perlcriticrc
-t/developer/pod.t
-t/developer/spelling.t
t/edge-cases.t
t/Exception.t
t/import.t
@@ -18,6 +14,10 @@
t/rt.t
t/stacktrace.t
t/throws_ok.t
+xt/documented.t
+xt/perlcritic.t
+xt/perlcriticrc
+xt/pod.t
+xt/spelling.t
Makefile.PL
-README
META.yml
Modified: trunk/libtest-exception-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/META.yml?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/META.yml (original)
+++ trunk/libtest-exception-perl/META.yml Mon Oct 11 13:00:23 2010
@@ -1,10 +1,19 @@
---
-name: Test-Exception
-version: 0.29
+abstract: 'Test exception based code'
author:
- 'Adrian Howard <adrianh at quietstars.com>'
-abstract: Test exception based code
+configure_requires:
+ Module::Build: 0.36
+generated_by: 'Module::Build version 0.3607'
license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Test-Exception
+provides:
+ Test::Exception:
+ file: lib/Test/Exception.pm
+ version: 0.31
requires:
Sub::Uplevel: 0.18
Test::Builder: 0.7
@@ -12,15 +21,6 @@
Test::Harness: 2.03
Test::More: 0.7
Test::Simple: 0.7
-configure_requires:
- Module::Build: 0.35
-generated_by: Module::Build version 0.35
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
-provides:
- Test::Exception:
- file: lib/Test/Exception.pm
- version: 0.29
resources:
license: http://dev.perl.org/licenses/
+version: 0.31
Modified: trunk/libtest-exception-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/Makefile.PL?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/Makefile.PL (original)
+++ trunk/libtest-exception-perl/Makefile.PL Mon Oct 11 13:00:23 2010
@@ -1,19 +1,19 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.35
+# Note: this file was auto-generated by Module::Build::Compat version 0.3607
use ExtUtils::MakeMaker;
WriteMakefile
(
- 'PL_FILES' => {},
- 'INSTALLDIRS' => 'site',
- 'NAME' => 'Test::Exception',
- 'EXE_FILES' => [],
- 'VERSION_FROM' => 'lib/Test/Exception.pm',
- 'PREREQ_PM' => {
- 'Test::More' => '0.7',
- 'Test::Harness' => '2.03',
- 'Test::Builder' => '0.7',
- 'Sub::Uplevel' => '0.18',
- 'Test::Simple' => '0.7',
- 'Test::Builder::Tester' => '1.07'
- }
- )
+ 'NAME' => 'Test::Exception',
+ 'VERSION_FROM' => 'lib/Test/Exception.pm',
+ 'PREREQ_PM' => {
+ 'Sub::Uplevel' => '0.18',
+ 'Test::Builder' => '0.7',
+ 'Test::Builder::Tester' => '1.07',
+ 'Test::Harness' => '2.03',
+ 'Test::More' => '0.7',
+ 'Test::Simple' => '0.7'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
+)
;
Modified: trunk/libtest-exception-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/README?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/README (original)
+++ trunk/libtest-exception-perl/README Mon Oct 11 13:00:23 2010
@@ -108,6 +108,11 @@
A description of the exception being checked is used if no optional
test description is passed.
+ NOTE: Rememeber when you "die $string_without_a_trailing_newline"
+ perl will automatically add the current script line number, input
+ line number and a newline. This will form part of the string that
+ throws_ok regular expressions match against.
+
dies_ok
Checks that a piece of code dies, rather than returning normally.
For example:
@@ -260,11 +265,12 @@
Thanks to Adam Kennedy, Andy Lester, Aristotle Pagaltzis, Ben Prew, Cees
Hek, Chris Dolan, chromatic, Curt Sampson, David Cantrell, David Golden,
- David Wheeler, Janek Schleicher, Jim Keenan, Jos I. Boumans, Joshua ben
- Jore, Jost Krieger, Mark Fowler, Michael G Schwern, Nadim Khemir, Paul
- McCann, Perrin Harkins, Peter Scott, Ricardo Signes, Rob Muhlestein
- Scott R. Godin, Steve Purkis, Steve, Tim Bunce, and various anonymous
- folk for comments, suggestions, bug reports and patches.
+ David Tulloh, David Wheeler, J. K. O'Brien, Janek Schleicher, Jim
+ Keenan, Jos I. Boumans, Joshua ben Jore, Jost Krieger, Mark Fowler,
+ Michael G Schwern, Nadim Khemir, Paul McCann, Perrin Harkins, Peter
+ Rabbitson, Peter Scott, Ricardo Signes, Rob Muhlestein, Scott R. Godin,
+ Steve Purkis, Steve, Tim Bunce, and various anonymous folk for comments,
+ suggestions, bug reports and patches.
AUTHOR
Adrian Howard <adrianh at quietstars.com>
Modified: trunk/libtest-exception-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/debian/changelog?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/debian/changelog (original)
+++ trunk/libtest-exception-perl/debian/changelog Mon Oct 11 13:00:23 2010
@@ -1,3 +1,16 @@
+libtest-exception-perl (0.31-1) unstable; urgency=low
+
+ * New upstream release.
+ * Use debhelper compat level 8 for Build.PL.
+ * Add build-dep on libmodule-build-perl >= 0.360000.
+ * Use source format 3.0 (quilt).
+ * debian/copyright: Refer to "Debian systems" instead of "Debian GNU/Linux
+ systems"; refer to /usr/share/common-licenses/GPL-1.
+ * Bump Standards-Version to 3.9.1.
+ * Add myself to Uploaders.
+
+ -- Ansgar Burchardt <ansgar at debian.org> Mon, 11 Oct 2010 14:58:13 +0200
+
libtest-exception-perl (0.29-1) unstable; urgency=low
[ Jonathan Yu ]
Modified: trunk/libtest-exception-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/debian/compat?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/debian/compat (original)
+++ trunk/libtest-exception-perl/debian/compat Mon Oct 11 13:00:23 2010
@@ -1,1 +1,1 @@
-7
+8
Modified: trunk/libtest-exception-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/debian/control?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/debian/control (original)
+++ trunk/libtest-exception-perl/debian/control Mon Oct 11 13:00:23 2010
@@ -1,13 +1,15 @@
Source: libtest-exception-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl, libsub-uplevel-perl (>= 0.18)
+Build-Depends: debhelper (>= 8)
+Build-Depends-Indep: perl, libmodule-build-perl (>= 0.360000),
+ libsub-uplevel-perl (>= 0.18)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Jay Bonci <jaybonci at debian.org>,
gregor herrmann <gregoa at debian.org>, Jonathan Yu <jawnsy at cpan.org>,
- Jeremiah C. Foster <jeremiah at jeremiahfoster.com>
-Standards-Version: 3.8.3
+ Jeremiah C. Foster <jeremiah at jeremiahfoster.com>,
+ Ansgar Burchardt <ansgar at debian.org>
+Standards-Version: 3.9.1
Homepage: http://search.cpan.org/dist/Test-Exception/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libtest-exception-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libtest-exception-perl/
Modified: trunk/libtest-exception-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/debian/copyright?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/debian/copyright (original)
+++ trunk/libtest-exception-perl/debian/copyright Mon Oct 11 13:00:23 2010
@@ -17,8 +17,8 @@
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License, which comes with Perl.
.
- On Debian GNU/Linux systems, the complete text of the Artistic License
- can be found in `/usr/share/common-licenses/Artistic'
+ On Debian systems, the complete text of the Artistic License can be
+ found in `/usr/share/common-licenses/Artistic'.
License: GPL-1+
This program is free software; you can redistribute it and/or modify
@@ -26,5 +26,5 @@
the Free Software Foundation; either version 1, or (at your option)
any later version.
.
- On Debian GNU/Linux systems, the complete text of the GNU General
- Public License can be found in `/usr/share/common-licenses/GPL'
+ On Debian systems, the complete text of version 1 of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.
Added: trunk/libtest-exception-perl/debian/source/format
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/debian/source/format?rev=63597&op=file
==============================================================================
--- trunk/libtest-exception-perl/debian/source/format (added)
+++ trunk/libtest-exception-perl/debian/source/format Mon Oct 11 13:00:23 2010
@@ -1,0 +1,1 @@
+3.0 (quilt)
Modified: trunk/libtest-exception-perl/lib/Test/Exception.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/lib/Test/Exception.pm?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/lib/Test/Exception.pm (original)
+++ trunk/libtest-exception-perl/lib/Test/Exception.pm Mon Oct 11 13:00:23 2010
@@ -6,7 +6,7 @@
use Sub::Uplevel qw( uplevel );
use base qw( Exporter );
-our $VERSION = '0.29';
+our $VERSION = '0.31';
our @EXPORT = qw(dies_ok lives_ok throws_ok lives_and);
my $Tester = Test::Builder->new;
@@ -85,11 +85,44 @@
sub _quiet_caller (;$) { ## no critic Prototypes
my $height = $_[0];
$height++;
- if( wantarray and !@_ ) {
- return (CORE::caller($height))[0..2];
+
+ if ( CORE::caller() eq 'DB' ) {
+ # passthrough the @DB::args trick
+ package DB;
+ if( wantarray ) {
+ if ( !@_ ) {
+ return (CORE::caller($height))[0..2];
+ }
+ else {
+ # If we got here, we are within a Test::Exception test, and
+ # something is producing a stacktrace. In case this is a full
+ # trace (i.e. confess() ), we have to make sure that the sub
+ # args are not visible. If we do not do this, and the test in
+ # question is throws_ok() with a regex, it will end up matching
+ # against itself in the args to throws_ok().
+ #
+ # While it is possible (and maybe wise), to test if we are
+ # indeed running under throws_ok (by crawling the stack right
+ # up from here), the old behavior of Test::Exception was to
+ # simply obliterate @DB::args altogether in _quiet_caller, so
+ # we are just preserving the behavior to avoid surprises
+ #
+ my @frame_info = CORE::caller($height);
+ @DB::args = ();
+ return @frame_info;
+ }
+ }
+
+ # fallback if nothing above returns
+ return CORE::caller($height);
}
else {
- return CORE::caller($height);
+ if( wantarray and !@_ ) {
+ return (CORE::caller($height))[0..2];
+ }
+ else {
+ return CORE::caller($height);
+ }
}
}
@@ -164,6 +197,11 @@
A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any).
A description of the exception being checked is used if no optional test description is passed.
+
+NOTE: Rememeber when you C<die $string_without_a_trailing_newline> perl will
+automatically add the current script line number, input line number and a newline. This will
+form part of the string that throws_ok regular expressions match against.
+
=cut
@@ -394,7 +432,9 @@
Curt Sampson,
David Cantrell,
David Golden,
+David Tulloh,
David Wheeler,
+J. K. O'Brien,
Janek Schleicher,
Jim Keenan,
Jos I. Boumans,
@@ -405,16 +445,16 @@
Nadim Khemir,
Paul McCann,
Perrin Harkins,
+Peter Rabbitson,
Peter Scott,
Ricardo Signes,
-Rob Muhlestein
+Rob Muhlestein,
Scott R. Godin,
Steve Purkis,
Steve,
Tim Bunce,
and various anonymous folk for comments, suggestions, bug reports and patches.
-
=head1 AUTHOR
Adrian Howard <adrianh at quietstars.com>
Modified: trunk/libtest-exception-perl/t/Exception.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/t/Exception.t?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/t/Exception.t (original)
+++ trunk/libtest-exception-perl/t/Exception.t Mon Oct 11 13:00:23 2010
@@ -156,4 +156,7 @@
test_out("ok 1 - ");
throws_ok { normal_die() } '/normal/', '';
-test_test("throws_ok: can pass empty test description");
+{
+ local $TODO = "See http://github.com/schwern/test-more/issues/issue/84";
+ test_test("throws_ok: can pass empty test description");
+}
Modified: trunk/libtest-exception-perl/t/caller.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/t/caller.t?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/t/caller.t (original)
+++ trunk/libtest-exception-perl/t/caller.t Mon Oct 11 13:00:23 2010
@@ -6,9 +6,28 @@
use warnings;
use Test::Exception;
-use Test::More tests => 2;
+use Test::More tests => 3;
eval { die caller() . "\n" };
is( $@, "main\n" );
throws_ok { die caller() . "\n" } qr/^main$/;
+
+
+# Make sure our override of caller() does not mess up @DB::args and thus Carp
+# The test is rather strange, but there is no clearer way to trigger this
+# error. For details see:
+# http://rt.perl.org/rt3/Public/Bug/Display.html?id=52610#txn-713770
+
+require Carp;
+my $croaker = sub { Carp::croak ('No bizarre errors') };
+
+for my $x (1..1) {
+ eval { $croaker->($x) };
+}
+
+throws_ok (
+ sub { $croaker->() },
+ qr/No bizarre errors/,
+ "Croak works properly (final)",
+);
Modified: trunk/libtest-exception-perl/t/stacktrace.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-exception-perl/t/stacktrace.t?rev=63597&op=diff
==============================================================================
--- trunk/libtest-exception-perl/t/stacktrace.t (original)
+++ trunk/libtest-exception-perl/t/stacktrace.t Mon Oct 11 13:00:23 2010
@@ -4,15 +4,35 @@
use warnings;
use Sub::Uplevel;
use Carp;
-use Test::Builder::Tester tests => 2;
+use Test::Builder::Tester tests => 3;
use Test::More;
BEGIN { use_ok( 'Test::Exception' ) };
-test_out('not ok 1 - threw /fribble/');
-test_fail(+1);
-throws_ok { confess('died') } '/fribble/';
-my $exception = $@;
-test_diag('expecting: /fribble/');
-test_diag(split /\n/, "found: $exception");
-test_test('regex in stacktrace ignored');
+# This test in essence makes sure that no false
+# positives are encountered due to @DB::args being part
+# of the stacktrace
+# The test seems rather complex due to the fact that
+# we make a really tricky stacktrace
+
+test_false_positive($_) for ('/fribble/', qr/fribble/);
+
+sub throw { confess ('something unexpected') }
+sub try { throw->(@_) }
+sub test_false_positive {
+ my $test_against_desc = my $test_against = shift;
+
+ if (my $ref = ref ($test_against) ) {
+ $test_against_desc = "$ref ($test_against_desc)"
+ if $test_against_desc !~ /^\Q$ref\E/;
+ }
+
+ test_out("not ok 1 - threw $test_against_desc");
+ test_fail(+1);
+ throws_ok { try ('fribble') } $test_against;
+ my $exception = $@;
+
+ test_diag("expecting: $test_against_desc");
+ test_diag(split /\n/, "found: $exception");
+ test_test("$test_against_desc in stacktrace ignored");
+}
More information about the Pkg-perl-cvs-commits
mailing list