r43839 - in /branches/upstream/libtest-warn-perl/current: Changes MANIFEST META.yml Makefile.PL README Warn.pm t/carped.t t/warning_is.t t/warning_like.t t/warnings_exist.t t/warnings_exist1.pl t/warnings_like.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Tue Sep 8 13:33:47 UTC 2009
Author: dmn
Date: Tue Sep 8 13:33:41 2009
New Revision: 43839
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=43839
Log:
[svn-upgrade] Integrating new upstream version, libtest-warn-perl (0.21)
Added:
branches/upstream/libtest-warn-perl/current/t/warnings_exist.t
branches/upstream/libtest-warn-perl/current/t/warnings_exist1.pl
Modified:
branches/upstream/libtest-warn-perl/current/Changes
branches/upstream/libtest-warn-perl/current/MANIFEST
branches/upstream/libtest-warn-perl/current/META.yml
branches/upstream/libtest-warn-perl/current/Makefile.PL
branches/upstream/libtest-warn-perl/current/README
branches/upstream/libtest-warn-perl/current/Warn.pm
branches/upstream/libtest-warn-perl/current/t/carped.t
branches/upstream/libtest-warn-perl/current/t/warning_is.t
branches/upstream/libtest-warn-perl/current/t/warning_like.t
branches/upstream/libtest-warn-perl/current/t/warnings_like.t
Modified: branches/upstream/libtest-warn-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/Changes?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/Changes (original)
+++ branches/upstream/libtest-warn-perl/current/Changes Tue Sep 8 13:33:41 2009
@@ -1,6 +1,27 @@
Revision history for Perl extension Test::Warn.
-0.11 Jun 09 2008
+0.21 Aug 29 2009
+ - rename internal package Tree::MyDAG_Node with Test::Warn::DAG_Node_Tree
+
+0.20 Aug 29 2009
+ - fix warning_exists.t for perl 5.6.2
+ - warnings_exists was renamed to warnings_exist
+ - compatibility layer in Makefile.PL
+
+0.11_02 Jun 16 2009
+ - carped.t will work on VMS (RT#39579)
+ - fix warning_exists.t for perl 5.10
+ - warning_exists was renamed to warnings_exists
+
+0.11_01 Jun 14 2009
+ - small changes
+ - MIN_PERL_VERSION in Makefile.PL
+ - Array::Compare is not needed
+ - allow files with spaces in path (RT#21545 by frew )
+ - Test::Exception is also not needed
+ - warning_exists added
+
+0.11 Jul 09 2008
- better Makefile.PL
- mention Test::Trap
- uplevel 2 changed to uplevel 1 to work with Sub::Uplevel 0.19_02
Modified: branches/upstream/libtest-warn-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/MANIFEST?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/MANIFEST (original)
+++ branches/upstream/libtest-warn-perl/current/MANIFEST Tue Sep 8 13:33:41 2009
@@ -8,6 +8,8 @@
t/warning_like.t
t/warnings_are.t
t/warnings_like.t
+t/warnings_exist.t
+t/warnings_exist1.pl
t/carped.t
t/pod.t
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libtest-warn-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/META.yml?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/META.yml (original)
+++ branches/upstream/libtest-warn-perl/current/META.yml Tue Sep 8 13:33:41 2009
@@ -1,21 +1,33 @@
--- #YAML:1.0
-name: Test-Warn
-version: 0.11
-abstract: Perl extension to test methods for warnings
-license: perl
-generated_by: ExtUtils::MakeMaker version 6.32
-distribution_type: module
-requires:
- Array::Compare: 0
- File::Spec: 0
- Sub::Uplevel: 0.12
- Test::Builder: 0.13
- Test::Builder::Tester: 1.02
- Test::Exception: 0
- Test::More: 0
- Tree::DAG_Node: 0
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+name: Test-Warn
+version: 0.21
+abstract: Perl extension to test methods for warnings
author:
- Alexandr Ciornii <alexchorny at gmail.com>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ File::Spec: 0
+ perl: 5.006
+ Sub::Uplevel: 0.12
+ Test::Builder: 0.13
+ Test::Builder::Tester: 1.02
+ Test::More: 0
+ Tree::DAG_Node: 0
+resources:
+ repository: http://github.com/chorny/test-warn/tree
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.50
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+keywords:
+ - testing
+ - warnings
Modified: branches/upstream/libtest-warn-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/Makefile.PL?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/Makefile.PL (original)
+++ branches/upstream/libtest-warn-perl/current/Makefile.PL Tue Sep 8 13:33:41 2009
@@ -3,21 +3,52 @@
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
-WriteMakefile(
+WriteMakefile1(
'NAME' => 'Test::Warn',
'VERSION_FROM' => 'Warn.pm', # finds $VERSION
- 'PREREQ_PM' => {
- 'Array::Compare' => 0,
- 'Test::Exception' => 0,
+ 'PREREQ_PM' => {
+ #'Array::Compare' => 0,
+ #'Test::Exception' => 0,
'Test::Builder' => 0.13,
'Test::Builder::Tester' => 1.02,
'Sub::Uplevel' => 0.12,
'Tree::DAG_Node' => 0,
+ },
+ 'BUILD_REQUIRES' => {
'File::Spec' => 0,
'Test::More' => 0,
- }, # e.g., Module::Name => 1.1
+ },
+ 'LICENSE' => 'perl',
+ 'MIN_PERL_VERSION' => 5.006,
ABSTRACT_FROM => 'Warn.pm', # retrieve abstract from module
AUTHOR => 'Alexandr Ciornii <alexchorny'.'@gmail.com>',
- ($ExtUtils::MakeMaker::VERSION ge '6.31'?
- ('LICENSE' => 'perl', ) : ()),
+ META_MERGE => {
+ resources => {
+ repository => 'http://github.com/chorny/test-warn/tree',
+ },
+ keywords => ['testing','warnings'],
+ },
);
+
+sub WriteMakefile1 {
+ 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
+ #Should be modified in future when EUMM will
+ #correctly support BUILD_REQUIRES.
+ #EUMM 6.5502 has problems with BUILD_REQUIRES
+ $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} };
+ delete $params{BUILD_REQUIRES};
+ }
+ delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
+ delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
+ delete $params{META_MERGE} if $eumm_version < 6.46;
+ delete $params{META_ADD} if $eumm_version < 6.46;
+ delete $params{LICENSE} if $eumm_version < 6.31;
+ delete $params{AUTHOR} if $] < 5.005;
+ delete $params{ABSTRACT_FROM} if $] < 5.005;
+ WriteMakefile(%params);
+}
Modified: branches/upstream/libtest-warn-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/README?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/README (original)
+++ branches/upstream/libtest-warn-perl/current/README Tue Sep 8 13:33:41 2009
@@ -1,4 +1,4 @@
-Test/Warn version 0.10
+Test/Warn version 0.21
======================
INSTALLATION
@@ -15,8 +15,6 @@
This module requires these other modules and libraries:
Test::Builder
-Test::Exception
-Array::Compare
Sub::Uplevel
List::Util
Tree::DAG_Node
@@ -70,6 +68,7 @@
COPYRIGHT AND LICENSE
Copyright 2002 by Janek Schleicher
+ Copyright 2007-2009 by Alexandr Ciornii
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: branches/upstream/libtest-warn-perl/current/Warn.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/Warn.pm?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/Warn.pm (original)
+++ branches/upstream/libtest-warn-perl/current/Warn.pm Tue Sep 8 13:33:41 2009
@@ -25,7 +25,11 @@
[qw/void uninitialized/],
"some warnings at compile time";
+ warnings_exist {...} [qr/expected warning/], "Expected warning is thrown";
+
=head1 DESCRIPTION
+
+A good style of Perl programming calls for a lot of diverse regression tests.
This module provides a few convenience methods for testing warning based code.
@@ -41,8 +45,8 @@
Tests that BLOCK gives exactly the one specificated warning.
The test fails if the BLOCK warns more then one times or doesn't warn.
If the string is undef,
-then the tests succeeds iff the BLOCK doesn't give any warning.
-Another way to say that there aren't ary warnings in the block,
+then the tests succeeds if the BLOCK doesn't give any warning.
+Another way to say that there aren't any warnings in the block,
is C<warnings_are {foo()} [], "no warnings in">.
If you want to test for a warning given by carp,
@@ -60,7 +64,7 @@
warning_is and warning_are are only aliases to the same method.
So you also could write
C<warning_is {foo()} [], "no warning"> or something similar.
-I decided me to give two methods to have some better readable method names.
+I decided to give two methods to have some better readable method names.
A true value is returned if the test succeeds, false otherwise.
@@ -73,7 +77,7 @@
The test fails if the BLOCK warns a different number than the size of the ARRAYREf
would have expected.
If the ARRAYREF is equal to [],
-then the test succeeds iff the BLOCK doesn't give any warning.
+then the test succeeds if the BLOCK doesn't give any warning.
Please read also the notes to warning_is as these methods are only aliases.
@@ -122,7 +126,7 @@
Note, that they have the hierarchical structure from perl 5.8.0,
wich has a little bit changed to 5.6.1 or earlier versions
(You can access the internal used tree with C<$Test::Warn::Categorization::tree>,
-allthough I wouldn't recommend it)
+although I wouldn't recommend it)
Thanks to the grouping in a tree,
it's simple possible to test for an 'io' warning,
@@ -162,6 +166,17 @@
],
"I hope, you'll never have to write a test for so many warnings :-)";
+=item warnings_exist BLOCK STRING|ARRAYREF, TEST_NAME
+
+Same as warning_like, but will warn() all warnings that do not match the supplied regex/category,
+instead of registering an error. Use this test when you just want to make sure that specific
+warnings were generated, and couldn't care less if other warnings happened in the same block
+of code.
+
+ warnings_exist {...} [qr/expected warning/], "Expected warning is thrown";
+
+ warnings_exist {...} ['uninitialized'], "Expected warning is thrown";
+
=back
=head2 EXPORT
@@ -169,12 +184,13 @@
C<warning_is>,
C<warnings_are>,
C<warning_like>,
-C<warnings_like> by default.
+C<warnings_like>,
+C<warnings_exist> by default.
=head1 BUGS
Please note that warnings with newlines inside are making a lot of trouble.
-The only sensful way to handle them is to use are the C<warning_like> or
+The only sensible way to handle them is to use are the C<warning_like> or
C<warnings_like> methods. Background for these problems is that there is no
really secure way to distinguish between warnings with newlines and a tracing
stacktrace.
@@ -213,6 +229,8 @@
Copyright 2002 by Janek Schleicher
+Copyright 2007-2009 by Alexandr Ciornii, L<http://chorny.net/>
+
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -225,10 +243,10 @@
use strict;
use warnings;
-use Array::Compare;
+#use Array::Compare;
use Sub::Uplevel 0.12;
-our $VERSION = '0.11';
+our $VERSION = '0.21';
require Exporter;
@@ -243,12 +261,17 @@
our @EXPORT = qw(
warning_is warnings_are
warning_like warnings_like
+ warnings_exist
);
use Test::Builder;
my $Tester = Test::Builder->new;
+{
+no warnings 'once';
*warning_is = *warnings_are;
+*warning_like = *warnings_like;
+}
sub warnings_are (&$;$) {
my $block = shift;
@@ -268,7 +291,6 @@
return $ok;
}
-*warning_like = *warnings_like;
sub warnings_like (&$;$) {
my $block = shift;
@@ -288,6 +310,32 @@
return $ok;
}
+sub warnings_exist (&$;$) {
+ my $block = shift;
+ my @exp_warning = map {_canonical_exp_warning($_)}
+ _to_array_if_necessary( shift() || [] );
+ my $testname = shift;
+ my @got_warning = ();
+ local $SIG{__WARN__} = sub {
+ my ($called_from) = caller(0); # to find out Carping methods
+ my $wrn_text=shift;
+ my $wrn_rec=_canonical_got_warning($called_from, $wrn_text);
+ foreach my $wrn (@exp_warning) {
+ if (_cmp_got_to_exp_warning_like($wrn_rec,$wrn)) {
+ push @got_warning, $wrn_rec;
+ return;
+ }
+ }
+ warn $wrn_text;
+ };
+ uplevel 1,$block;
+ my $ok = _cmp_like( \@got_warning, \@exp_warning );
+ $Tester->ok( $ok, $testname );
+ $ok or _diag_found_warning(@got_warning),
+ _diag_exp_warning(@exp_warning);
+ return $ok;
+}
+
sub _to_array_if_necessary {
return (ref($_[0]) eq 'ARRAY') ? @{$_[0]} : ($_[0]);
@@ -315,7 +363,7 @@
my ($got_kind, $got_msg) = %{ shift() };
my ($exp_kind, $exp_msg) = %{ shift() };
return 0 if ($got_kind eq 'warn') && ($exp_kind eq 'carped');
- my $cmp = $got_msg =~ /^\Q$exp_msg\E at \S+ line \d+\.?$/;
+ my $cmp = $got_msg =~ /^\Q$exp_msg\E at .+ line \d+\.?$/;
return $cmp;
}
@@ -323,7 +371,7 @@
my ($got_kind, $got_msg) = %{ shift() };
my ($exp_kind, $exp_msg) = %{ shift() };
return 0 if ($got_kind eq 'warn') && ($exp_kind eq 'carped');
- if (my $re = $Tester->maybe_regex($exp_msg)) {
+ if (my $re = $Tester->maybe_regex($exp_msg)) { #qr// or '//'
my $cmp = $got_msg =~ /$re/;
return $cmp;
} else {
@@ -374,7 +422,7 @@
$Tester->diag( "didn't expect to find a warning" ) unless @_;
}
-package Tree::MyDAG_Node;
+package Test::Warn::DAG_Node_Tree;
use strict;
use warnings;
@@ -420,7 +468,7 @@
use Carp;
-our $tree = Tree::MyDAG_Node->nice_lol_to_tree(
+our $tree = Test::Warn::DAG_Node_Tree->nice_lol_to_tree(
all => [ 'closure',
'deprecated',
'exiting',
@@ -471,7 +519,7 @@
);
sub _warning_category_regexp {
- my $sub_tree = $tree->depthsearch(shift()) or return undef;
+ my $sub_tree = $tree->depthsearch(shift()) or return;
my $re = join "|", map {$_->name} $sub_tree->leaves_under;
return qr/(?=\w)$re/;
}
@@ -479,7 +527,7 @@
sub warning_like_category {
my ($warning, $category) = @_;
my $re = _warning_category_regexp($category) or
- carp("Unknown warning category '$category'"),return undef;
+ carp("Unknown warning category '$category'"),return;
my $ok = $warning =~ /$re/;
return $ok;
}
Modified: branches/upstream/libtest-warn-perl/current/t/carped.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/t/carped.t?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/t/carped.t (original)
+++ branches/upstream/libtest-warn-perl/current/t/carped.t Tue Sep 8 13:33:41 2009
@@ -16,9 +16,11 @@
warn "Warning 4";
}
-use File::Spec;
-my $tcarped = File::Spec->catfile('t','carped.t');
-$tcarped =~ s/\\/\//g if $^O eq 'MSWin32';
+#use File::Spec;
+#my $tcarped = File::Spec->catfile('t','carped.t');
+#$tcarped =~ s/\\/\//g if $^O eq 'MSWin32';
+#also will not work on VMS
+my $tcarped = 't/carped.t';
test_out "ok 1";
warnings_like {foo()} [map {qr/$_/} (1 .. 4)];
Modified: branches/upstream/libtest-warn-perl/current/t/warning_is.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/t/warning_is.t?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/t/warning_is.t (original)
+++ branches/upstream/libtest-warn-perl/current/t/warning_is.t Tue Sep 8 13:33:41 2009
@@ -25,7 +25,7 @@
use Test::Builder::Tester tests => TESTS() * SUBTESTS_PER_TESTS;
use Test::Warn;
-use Test::Exception;
+#use Test::Exception;
Test::Builder::Tester::color 'on';
Modified: branches/upstream/libtest-warn-perl/current/t/warning_like.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/t/warning_like.t?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/t/warning_like.t (original)
+++ branches/upstream/libtest-warn-perl/current/t/warning_like.t Tue Sep 8 13:33:41 2009
@@ -10,6 +10,7 @@
use Carp;
+#expected, warning text, expected, test name
use constant TESTS =>(
["ok", "my warning", "my", "standard warning to find"],
["not ok", "my warning", "another", "another warning instead of my warning"],
@@ -23,7 +24,7 @@
use constant SUBTESTS_PER_TESTS => 12;
use Test::Builder::Tester tests => TESTS() * SUBTESTS_PER_TESTS;
-use Test::Exception;
+#use Test::Exception;
use Test::Warn;
Test::Builder::Tester::color 'on';
Added: branches/upstream/libtest-warn-perl/current/t/warnings_exist.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/t/warnings_exist.t?rev=43839&op=file
==============================================================================
--- branches/upstream/libtest-warn-perl/current/t/warnings_exist.t (added)
+++ branches/upstream/libtest-warn-perl/current/t/warnings_exist.t Tue Sep 8 13:33:41 2009
@@ -1,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Carp;
+use Test::More qw(no_plan);
+
+my $file="t/warnings_exist1.pl";
+my $output=`$^X -Mblib $file 2>&1`;
+$output=~s/^#.*$//gm;
+$output=~s/\n{2,}/\n/gs;
+my @lines=split /[\n\r]+/,$output;
+shift @lines if $lines[0]=~/^Using /; #extra line in perl 5.6.2
+#print $output;
+my @expected=(
+"warn_2 at $file line 12.",
+'ok 1',
+'ok 2',
+"warn_2 at $file line 21.",
+'not ok 3',
+"warn_2 at $file line 27.",
+'ok 4',
+"warn_2 at $file line 31.",
+'not ok 5',
+qr/^Use of uninitialized value (?:\$a\s+)?in addition \(\+\) at \Q$file\E line 36\.$/,
+'ok 6',
+'1..6'
+);
+foreach my $i (0..$#expected) {
+ if ($expected[$i]=~/^\(\?\w*-\w*:/) {
+ like($lines[$i],$expected[$i]);
+ } else {
+ is($lines[$i],$expected[$i]);
+ }
+}
Added: branches/upstream/libtest-warn-perl/current/t/warnings_exist1.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/t/warnings_exist1.pl?rev=43839&op=file
==============================================================================
--- branches/upstream/libtest-warn-perl/current/t/warnings_exist1.pl (added)
+++ branches/upstream/libtest-warn-perl/current/t/warnings_exist1.pl Tue Sep 8 13:33:41 2009
@@ -1,0 +1,39 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw(no_plan);
+use Test::Warn;
+
+
+warnings_exist {
+ warn "warn_1";
+ warn "warn_2";
+} [qr/warn_1/];
+
+warnings_exist {
+ warn "warn_1";
+ warn "warn_2";
+} [qr/warn_1/,qr/warn_2/];
+
+warnings_exist {
+ warn "warn_2";
+} [qr/warn_1/];
+
+warnings_exist {
+ my $a;
+ $b=$a+1;
+ warn "warn_2";
+} ['uninitialized'];
+
+warnings_exist {
+ warn "warn_2";
+} ['uninitialized'];
+
+warnings_exist {
+ my $a;
+ $b=$a+1;
+ warn "warn_2";
+} [qr/warn_2/];
+
Modified: branches/upstream/libtest-warn-perl/current/t/warnings_like.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-warn-perl/current/t/warnings_like.t?rev=43839&op=diff
==============================================================================
--- branches/upstream/libtest-warn-perl/current/t/warnings_like.t (original)
+++ branches/upstream/libtest-warn-perl/current/t/warnings_like.t Tue Sep 8 13:33:41 2009
@@ -8,9 +8,10 @@
use strict;
use warnings;
-use Test::Exception;
+#use Test::Exception;
use Carp;
+#expected, warning text, expected, test name
use constant TESTS =>(
[ "ok", ["my warning"], ["my"], "standard warning to find"],
["not ok", ["my warning"], ["another"], "another warning instead of my warning"],
More information about the Pkg-perl-cvs-commits
mailing list