Hello community, here is the log from the commit of package perl-Test-Warn for openSUSE:Factory checked in at 2015-02-08 11:42:53 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Test-Warn (Old) and /work/SRC/openSUSE:Factory/.perl-Test-Warn.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Test-Warn" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Test-Warn/perl-Test-Warn.changes 2012-05-31 17:08:56.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Test-Warn.new/perl-Test-Warn.changes 2015-02-08 11:42:54.000000000 +0100 @@ -1,0 +2,10 @@ +Thu Dec 4 15:51:41 UTC 2014 - ncut...@suse.com + +- updated to 0.30 + - important note in documentation how check for warning category is done + If you use Test::Warn with categories, you should check that it does + what you expect. + - Category tree is now dynamic and does not use Tree::DAG_Node (Graham Knop) +- regenerated spec file + +------------------------------------------------------------------- Old: ---- Test-Warn-0.24.tar.gz New: ---- Test-Warn-0.30.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Test-Warn.spec ++++++ --- /var/tmp/diff_new_pack.bru8uW/_old 2015-02-08 11:42:55.000000000 +0100 +++ /var/tmp/diff_new_pack.bru8uW/_new 2015-02-08 11:42:55.000000000 +0100 @@ -1,7 +1,7 @@ # # spec file for package perl-Test-Warn # -# Copyright (c) 2012 SUSE LINUX Products GmbH, Nuernberg, Germany. +# Copyright (c) 2014 SUSE LINUX Products GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,25 +17,22 @@ Name: perl-Test-Warn -Version: 0.24 +Version: 0.30 Release: 0 %define cpan_name Test-Warn Summary: Perl extension to test methods for warnings License: Artistic-1.0 or GPL-1.0+ Group: Development/Libraries/Perl Url: http://search.cpan.org/dist/Test-Warn/ -Source: http://www.cpan.org/authors/id/C/CH/CHORNY/%{cpan_name}-%{version}.tar.gz +Source: Test-Warn-0.30.tar.gz BuildArch: noarch BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl BuildRequires: perl-macros BuildRequires: perl(Carp) >= 1.22 BuildRequires: perl(Sub::Uplevel) >= 0.12 -BuildRequires: perl(Tree::DAG_Node) >= 1.02 -#BuildRequires: perl(Test::Warn) Requires: perl(Carp) >= 1.22 Requires: perl(Sub::Uplevel) >= 0.12 -Requires: perl(Tree::DAG_Node) >= 1.02 %{perl_requires} %description ++++++ Test-Warn-0.24.tar.gz -> Test-Warn-0.30.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/Changes new/Test-Warn-0.30/Changes --- old/Test-Warn-0.24/Changes 2012-04-01 02:11:31.000000000 +0200 +++ new/Test-Warn-0.30/Changes 2014-03-05 19:33:58.000000000 +0100 @@ -1,5 +1,11 @@ Revision history for Perl extension Test::Warn. +0.30 2014-03-05 + - important note in documentation how check for warning category is done + If you use Test::Warn with categories, you should check that it does + what you expect. + - Category tree is now dynamic and does not use Tree::DAG_Node (Graham Knop) + 0.24=0.23_01 2012-04-01 0.23_01 2012-02-25 - compatibility with Carp 1.25 (RURBAN) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/MANIFEST new/Test-Warn-0.30/MANIFEST --- old/Test-Warn-0.24/MANIFEST 2012-02-24 23:26:48.000000000 +0100 +++ new/Test-Warn-0.30/MANIFEST 2014-02-28 17:29:26.000000000 +0100 @@ -11,6 +11,5 @@ t/warnings_exist.t t/warnings_exist1.pl t/carped.t -t/pod.t META.yml Module meta-data (added by MakeMaker) META.json diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/META.json new/Test-Warn-0.30/META.json --- old/Test-Warn-0.24/META.json 2012-04-01 02:12:27.000000000 +0200 +++ new/Test-Warn-0.30/META.json 2014-03-05 19:34:58.000000000 +0100 @@ -4,7 +4,7 @@ "Alexandr Ciornii <alexcho...@gmail.com>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150", + "generated_by" : "ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490", "keywords" : [ "testing", "warnings" @@ -26,13 +26,13 @@ "prereqs" : { "build" : { "requires" : { - "File::Spec" : 0, - "Test::More" : 0 + "File::Spec" : "0", + "Test::More" : "0" } }, "configure" : { "requires" : { - "ExtUtils::MakeMaker" : 0 + "ExtUtils::MakeMaker" : "0" } }, "runtime" : { @@ -41,7 +41,6 @@ "Sub::Uplevel" : "0.12", "Test::Builder" : "0.13", "Test::Builder::Tester" : "1.02", - "Tree::DAG_Node" : "1.02", "perl" : "5.006" } } @@ -49,8 +48,8 @@ "release_status" : "stable", "resources" : { "repository" : { - "url" : "http://github.com/chorny/test-warn/tree"; + "url" : "https://github.com/chorny/test-warn"; } }, - "version" : "0.24" + "version" : "0.30" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/META.yml new/Test-Warn-0.30/META.yml --- old/Test-Warn-0.24/META.yml 2012-04-01 02:12:26.000000000 +0200 +++ new/Test-Warn-0.30/META.yml 2014-03-05 19:34:56.000000000 +0100 @@ -8,7 +8,7 @@ configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.112150' +generated_by: 'ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.131490' keywords: - testing - warnings @@ -26,8 +26,7 @@ Sub::Uplevel: 0.12 Test::Builder: 0.13 Test::Builder::Tester: 1.02 - Tree::DAG_Node: 1.02 perl: 5.006 resources: - repository: http://github.com/chorny/test-warn/tree -version: 0.24 + repository: https://github.com/chorny/test-warn +version: 0.30 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/Makefile.PL new/Test-Warn-0.30/Makefile.PL --- old/Test-Warn-0.24/Makefile.PL 2012-02-25 21:07:12.000000000 +0100 +++ new/Test-Warn-0.30/Makefile.PL 2014-01-27 18:49:27.000000000 +0100 @@ -1,60 +1,59 @@ -use 5.006; -use strict; -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. -WriteMakefile1( - 'NAME' => 'Test::Warn', - 'VERSION_FROM' => 'Warn.pm', # finds $VERSION - 'ABSTRACT_FROM' => 'Warn.pm', # retrieve abstract from module - 'PREREQ_PM' => { - #'Array::Compare' => 0, - #'Test::Exception' => 0, - 'Test::Builder' => 0.13, - 'Test::Builder::Tester' => 1.02, - 'Sub::Uplevel' => 0.12, - 'Tree::DAG_Node' => 1.02, - 'Carp' => 1.22, - }, - 'BUILD_REQUIRES' => { - 'File::Spec' => 0, - 'Test::More' => 0, - }, - 'LICENSE' => 'perl', - 'MIN_PERL_VERSION' => 5.006, - AUTHOR => 'Alexandr Ciornii <alexchorny'.'@gmail.com>', - META_MERGE => { - resources => { - repository => 'http://github.com/chorny/test-warn/tree', - }, - keywords => ['testing','warnings'], - }, - PL_FILES => {}, - $^O =~/win/i ? ( - dist => { - TAR => 'ptar', - TARFLAGS => '-c -C -f', - }, - ) : (), -); - -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) { - #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); -} +use 5.006; +use strict; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile1( + 'NAME' => 'Test::Warn', + 'VERSION_FROM' => 'Warn.pm', # finds $VERSION + 'ABSTRACT_FROM' => 'Warn.pm', # retrieve abstract from module + 'PREREQ_PM' => { + #'Array::Compare' => 0, + #'Test::Exception' => 0, + 'Test::Builder' => 0.13, + 'Test::Builder::Tester' => 1.02, + 'Sub::Uplevel' => 0.12, + 'Carp' => 1.22, + }, + 'BUILD_REQUIRES' => { + 'File::Spec' => 0, + 'Test::More' => 0, + }, + 'LICENSE' => 'perl', + 'MIN_PERL_VERSION' => 5.006, + AUTHOR => 'Alexandr Ciornii <alexchorny'.'@gmail.com>', + META_MERGE => { + resources => { + repository => 'https://github.com/chorny/test-warn', + }, + keywords => ['testing','warnings'], + }, + PL_FILES => {}, + $^O =~/win/i ? ( + dist => { + TAR => 'ptar', + TARFLAGS => '-c -C -f', + }, + ) : (), +); + +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) { + #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); +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/README new/Test-Warn-0.30/README --- old/Test-Warn-0.24/README 2012-04-01 02:11:52.000000000 +0200 +++ new/Test-Warn-0.30/README 2014-02-28 17:27:22.000000000 +0100 @@ -1,4 +1,4 @@ -Test/Warn version 0.24 +Test/Warn version 0.30 ====================== INSTALLATION @@ -19,8 +19,6 @@ Test::Builder Sub::Uplevel -List::Util -Tree::DAG_Node File::Spec SYNOPSIS @@ -71,7 +69,7 @@ COPYRIGHT AND LICENSE Copyright 2002 by Janek Schleicher - Copyright 2007-2009 by Alexandr Ciornii + Copyright 2007-2014 by Alexandr Ciornii This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/Warn.pm new/Test-Warn-0.30/Warn.pm --- old/Test-Warn-0.24/Warn.pm 2012-04-01 02:11:44.000000000 +0200 +++ new/Test-Warn-0.30/Warn.pm 2014-03-01 10:01:33.000000000 +0100 @@ -1,534 +1,464 @@ -=head1 NAME - -Test::Warn - Perl extension to test methods for warnings - -=head1 SYNOPSIS - - use Test::Warn; - - warning_is {foo(-dri => "/")} "Unknown Parameter 'dri'", "dri != dir gives warning"; - warnings_are {bar(1,1)} ["Width very small", "Height very small"]; - - warning_is {add(2,2)} undef, "No warnings for calc 2+2"; # or - warnings_are {add(2,2)} [], "No warnings for calc 2+2"; # what reads better :-) - - warning_like {foo(-dri => "/")} qr/unknown param/i, "an unknown parameter test"; - warnings_like {bar(1,1)} [qr/width.*small/i, qr/height.*small/i]; - - warning_is {foo()} {carped => "didn't find the right parameters"}; - warnings_like {foo()} [qr/undefined/,qr/undefined/,{carped => qr/no result/i}]; - - warning_like {foo(undef)} 'uninitialized'; - warning_like {bar(file => '/etc/passwd')} 'io'; - - warning_like {eval q/"$x"; $x;/} - [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. - -If you are not already familiar with the Test::More manpage -now would be the time to go take a look. - -=head2 FUNCTIONS - -=over 4 - -=item warning_is BLOCK STRING, TEST_NAME - -Tests that BLOCK gives the specified warning exactly once. -The test fails if the BLOCK warns more than once or does not warn at all. -If the string is undef, -then the tests succeeds if the BLOCK doesn't give any warning. -Another way to say that there are no warnings in the block -is C<warnings_are {foo()} [], "no warnings">. - -If you want to test for a warning given by Carp, -you have to write something like: -C<warning_is {carp "msg"} {carped =E<gt> 'msg'}, "Test for a carped warning">. -The test will fail if a "normal" warning is found instead of a "carped" one. - -Note: C<warn "foo"> would print something like C<foo at -e line 1>. -This method ignores everything after the "at". Thus to match this warning -you would have to call C<warning_is {warn "foo"} "foo", "Foo succeeded">. -If you need to test for a warning at an exactly line, -try something like C<warning_like {warn "foo"} qr/at XYZ.dat line 5/>. - -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 to give two methods the same name to improve readability. - -A true value is returned if the test succeeds, false otherwise. - -The test name is optional, but recommended. - - -=item warnings_are BLOCK ARRAYREF, TEST_NAME - -Tests to see that BLOCK gives exactly the specified warnings. -The test fails if the warnings from BLOCK are not exactly the ones in ARRAYREF. -If the ARRAYREF is equal to [], -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. - -If you want more than one test for carped warnings, try this: -C<warnings_are {carp "c1"; carp "c2"} {carped => ['c1','c2'];> or -C<warnings_are {foo()} ["Warning 1", {carped => ["Carp 1", "Carp 2"]}, "Warning 2"]>. -Note that C<{carped => ...}> must always be a hash ref. - -=item warning_like BLOCK REGEXP, TEST_NAME - -Tests that BLOCK gives exactly one warning and it can be matched by -the given regexp. -If the string is undef, -then the tests succeeds if the BLOCK doesn't give any warning. - -The REGEXP is matched against the whole warning line, -which in general has the form "WARNING at __FILE__ line __LINE__". -So you can check for a warning in the file Foo.pm on line 5 with -C<warning_like {bar()} qr/at Foo.pm line 5/, "Testname">. -I don't know whether it's sensful to do such a test :-( -However, you should be prepared as a matching with 'at', 'file', '\d' -or similar will always pass. -Think to the qr/^foo/ if you want to test for warning "foo something" in file foo.pl. - -You can also write the regexp in a string as "/.../" -instead of using the qr/.../ syntax. -Note that the slashes are important in the string, -as strings without slashes are reserved for warning categories -(to match warning categories as can be seen in the perllexwarn man page). - -Similar to C<warning_is>, -you can test for warnings via C<carp> with: -C<warning_like {bar()} {carped => qr/bar called too early/i};> - -Similar to C<warning_is>/C<warnings_are>, -C<warning_like> and C<warnings_like> are only aliases to the same methods. - -A true value is returned if the test succeeds, false otherwise. - -The test name is optional, but recommended. - -=item warning_like BLOCK STRING, TEST_NAME - -Tests whether a BLOCK gives exactly one warning of the passed category. -The categories are grouped in a tree, -like it is expressed in perllexwarn. -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>, -although I wouldn't recommend it) - -Thanks to the grouping in a tree, -it's simple possible to test for an 'io' warning, -instead for testing for a 'closed|exec|layer|newline|pipe|unopened' warning. - -Note, that warnings occuring at compile time, -can only be catched in an eval block. So - - warning_like {eval q/"$x"; $x;/} - [qw/void uninitialized/], - "some warnings at compile time"; - -will work, -while it wouldn't work without the eval. - -Note, that it isn't possible yet, -to test for own categories, -created with warnings::register. - -=item warnings_like BLOCK ARRAYREF, TEST_NAME - -Tests to see that BLOCK gives exactly the number of the specified warnings -and all the warnings have to match in the defined order to the -passed regexes. - -Please read also the notes to warning_like as these methods are only aliases. - -Similar to C<warnings_are>, -you can test for multiple warnings via C<carp> -and for warning categories, too: - - warnings_like {foo()} - [qr/bar warning/, - qr/bar warning/, - {carped => qr/bar warning/i}, - 'io' - ], - "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 - -C<warning_is>, -C<warnings_are>, -C<warning_like>, -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 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. - -If a method has it's own warn handler, -overwriting C<$SIG{__WARN__}>, -my test warning methods won't get these warnings. - -The C<warning_like BLOCK CATEGORY, TEST_NAME> method isn't extremely tested. -Please use this calling style with higher attention and -tell me if you find a bug. - -=head1 TODO - -Improve this documentation. - -The code has some parts doubled - especially in the test scripts. -This is really awkward and must be changed. - -Please feel free to suggest improvements. - -=head1 SEE ALSO - -Have a look to the similar modules: L<Test::Exception>, L<Test::Trap>. - -=head1 THANKS - -Many thanks to Adrian Howard, chromatic and Michael G. Schwern, -who have given me a lot of ideas. - -=head1 AUTHOR - -Janek Schleicher, E<lt>bigj AT kamelfreund.deE<gt> - -=head1 COPYRIGHT AND LICENSE - -Copyright 2002 by Janek Schleicher - -Copyright 2007-2011 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. - -=cut - - -package Test::Warn; - -use 5.006; -use strict; -use warnings; - -#use Array::Compare; -use Sub::Uplevel 0.12; - -our $VERSION = '0.24'; - -require Exporter; - -our @ISA = qw(Exporter); - -our %EXPORT_TAGS = ( 'all' => [ qw( - @EXPORT -) ] ); - -our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); - -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; - 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 - push @got_warning, _canonical_got_warning($called_from, shift()); - }; - uplevel 1,$block; - my $ok = _cmp_is( \@got_warning, \@exp_warning ); - $Tester->ok( $ok, $testname ); - $ok or _diag_found_warning(@got_warning), - _diag_exp_warning(@exp_warning); - return $ok; -} - - -sub warnings_like (&$;$) { - 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 - push @got_warning, _canonical_got_warning($called_from, shift()); - }; - 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 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]); -} - -sub _canonical_got_warning { - my ($called_from, $msg) = @_; - my $warn_kind = $called_from eq 'Carp' ? 'carped' : 'warn'; - my @warning_stack = split /\n/, $msg; # some stuff of uplevel is included - return {$warn_kind => $warning_stack[0]}; # return only the real message -} - -sub _canonical_exp_warning { - my ($exp) = @_; - if (ref($exp) eq 'HASH') { # could be {carped => ...} - my $to_carp = $exp->{carped} or return; # undefined message are ignored - return (ref($to_carp) eq 'ARRAY') # is {carped => [ ..., ...] } - ? map({ {carped => $_} } grep {defined $_} @$to_carp) - : +{carped => $to_carp}; - } - return {warn => $exp}; -} - -sub _cmp_got_to_exp_warning { - 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 .+ line \d+\.?$/; - return $cmp; -} - -sub _cmp_got_to_exp_warning_like { - 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)) { #qr// or '//' - my $cmp = $got_msg =~ /$re/; - return $cmp; - } else { - return Test::Warn::Categorization::warning_like_category($got_msg,$exp_msg); - } -} - - -sub _cmp_is { - my @got = @{ shift() }; - my @exp = @{ shift() }; - scalar @got == scalar @exp or return 0; - my $cmp = 1; - $cmp &&= _cmp_got_to_exp_warning($got[$_],$exp[$_]) for (0 .. $#got); - return $cmp; -} - -sub _cmp_like { - my @got = @{ shift() }; - my @exp = @{ shift() }; - scalar @got == scalar @exp or return 0; - my $cmp = 1; - $cmp &&= _cmp_got_to_exp_warning_like($got[$_],$exp[$_]) for (0 .. $#got); - return $cmp; -} - -sub _diag_found_warning { - foreach (@_) { - if (ref($_) eq 'HASH') { - ${$_}{carped} ? $Tester->diag("found carped warning: ${$_}{carped}") - : $Tester->diag("found warning: ${$_}{warn}"); - } else { - $Tester->diag( "found warning: $_" ); - } - } - $Tester->diag( "didn't find a warning" ) unless @_; -} - -sub _diag_exp_warning { - foreach (@_) { - if (ref($_) eq 'HASH') { - ${$_}{carped} ? $Tester->diag("expected to find carped warning: ${$_}{carped}") - : $Tester->diag("expected to find warning: ${$_}{warn}"); - } else { - $Tester->diag( "expected to find warning: $_" ); - } - } - $Tester->diag( "didn't expect to find a warning" ) unless @_; -} - -package Test::Warn::DAG_Node_Tree; - -use strict; -use warnings; -use base 'Tree::DAG_Node'; - - -sub nice_lol_to_tree { - my $class = shift; - $class->new( - { - name => shift(), - daughters => [_nice_lol_to_daughters(shift())] - }); -} - -sub _nice_lol_to_daughters { - my @names = @{ shift() }; - my @daughters = (); - my $last_daughter = undef; - foreach (@names) { - if (ref($_) ne 'ARRAY') { - $last_daughter = Tree::DAG_Node->new({name => $_}); - push @daughters, $last_daughter; - } else { - $last_daughter->add_daughters(_nice_lol_to_daughters($_)); - } - } - return @daughters; -} - -sub depthsearch { - my ($self, $search_name) = @_; - my $found_node = undef; - $self->walk_down({callback => sub { - my $node = shift(); - $node->name eq $search_name and $found_node = $node,!"go on"; - "go on with searching"; - }}); - return $found_node; -} - -package Test::Warn::Categorization; - -use Carp; - -our $tree = Test::Warn::DAG_Node_Tree->nice_lol_to_tree( - all => [ 'closure', - 'deprecated', - 'exiting', - 'glob', - 'io' => [ 'closed', - 'exec', - 'layer', - 'newline', - 'pipe', - 'unopened' - ], - 'misc', - 'numeric', - 'once', - 'overflow', - 'pack', - 'portable', - 'recursion', - 'redefine', - 'regexp', - 'severe' => [ 'debugging', - 'inplace', - 'internal', - 'malloc' - ], - 'signal', - 'substr', - 'syntax' => [ 'ambiguous', - 'bareword', - 'digit', - 'parenthesis', - 'precedence', - 'printf', - 'prototype', - 'qw', - 'reserved', - 'semicolon' - ], - 'taint', - 'threads', - 'uninitialized', - 'unpack', - 'untie', - 'utf8', - 'void', - 'y2k' - ] -); - -sub _warning_category_regexp { - my $sub_tree = $tree->depthsearch(shift()) or return; - my $re = join "|", map {$_->name} $sub_tree->leaves_under; - return qr/(?=\w)$re/; -} - -sub warning_like_category { - my ($warning, $category) = @_; - my $re = _warning_category_regexp($category) or - carp("Unknown warning category '$category'"),return; - my $ok = $warning =~ /$re/; - return $ok; -} - -1; +=head1 NAME + +Test::Warn - Perl extension to test methods for warnings + +=head1 SYNOPSIS + + use Test::Warn; + + warning_is {foo(-dri => "/")} "Unknown Parameter 'dri'", "dri != dir gives warning"; + warnings_are {bar(1,1)} ["Width very small", "Height very small"]; + + warning_is {add(2,2)} undef, "No warnings for calc 2+2"; # or + warnings_are {add(2,2)} [], "No warnings for calc 2+2"; # what reads better :-) + + warning_like {foo(-dri => "/")} qr/unknown param/i, "an unknown parameter test"; + warnings_like {bar(1,1)} [qr/width.*small/i, qr/height.*small/i]; + + warning_is {foo()} {carped => "didn't find the right parameters"}; + warnings_like {foo()} [qr/undefined/,qr/undefined/,{carped => qr/no result/i}]; + + warning_like {foo(undef)} 'uninitialized'; + warning_like {bar(file => '/etc/passwd')} 'io'; + + warning_like {eval q/"$x"; $x;/} + [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. + +If you are not already familiar with the Test::More manpage +now would be the time to go take a look. + +=head2 FUNCTIONS + +=over 4 + +=item warning_is BLOCK STRING, TEST_NAME + +Tests that BLOCK gives the specified warning exactly once. +The test fails if the BLOCK warns more than once or does not warn at all. +If the string is undef, +then the tests succeeds if the BLOCK doesn't give any warning. +Another way to say that there are no warnings in the block +is C<warnings_are {foo()} [], "no warnings">. + +If you want to test for a warning given by Carp, +you have to write something like: +C<warning_is {carp "msg"} {carped =E<gt> 'msg'}, "Test for a carped warning">. +The test will fail if a "normal" warning is found instead of a "carped" one. + +Note: C<warn "foo"> would print something like C<foo at -e line 1>. +This method ignores everything after the "at". Thus to match this warning +you would have to call C<warning_is {warn "foo"} "foo", "Foo succeeded">. +If you need to test for a warning at an exactly line, +try something like C<warning_like {warn "foo"} qr/at XYZ.dat line 5/>. + +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 to give two methods the same name to improve readability. + +A true value is returned if the test succeeds, false otherwise. + +The test name is optional, but recommended. + + +=item warnings_are BLOCK ARRAYREF, TEST_NAME + +Tests to see that BLOCK gives exactly the specified warnings. +The test fails if the warnings from BLOCK are not exactly the ones in ARRAYREF. +If the ARRAYREF is equal to [], +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. + +If you want more than one test for carped warnings, try this: +C<warnings_are {carp "c1"; carp "c2"} {carped => ['c1','c2'];> or +C<warnings_are {foo()} ["Warning 1", {carped => ["Carp 1", "Carp 2"]}, "Warning 2"]>. +Note that C<{carped => ...}> must always be a hash ref. + +=item warning_like BLOCK REGEXP, TEST_NAME + +Tests that BLOCK gives exactly one warning and it can be matched by +the given regexp. +If the string is undef, +then the tests succeeds if the BLOCK doesn't give any warning. + +The REGEXP is matched against the whole warning line, +which in general has the form "WARNING at __FILE__ line __LINE__". +So you can check for a warning in the file Foo.pm on line 5 with +C<warning_like {bar()} qr/at Foo.pm line 5/, "Testname">. +I don't know whether it makes sense to do such a test :-( +However, you should be prepared as a matching with 'at', 'file', '\d' +or similar will always pass. +Think to the qr/^foo/ if you want to test for warning "foo something" in file foo.pl. + +You can also write the regexp in a string as "/.../" +instead of using the qr/.../ syntax. +Note that the slashes are important in the string, +as strings without slashes are reserved for warning categories +(to match warning categories as can be seen in the perllexwarn man page). + +Similar to C<warning_is>, +you can test for warnings via C<carp> with: +C<warning_like {bar()} {carped => qr/bar called too early/i};> + +Similar to C<warning_is>/C<warnings_are>, +C<warning_like> and C<warnings_like> are only aliases to the same methods. + +A true value is returned if the test succeeds, false otherwise. + +The test name is optional, but recommended. + +=item warning_like BLOCK STRING, TEST_NAME + +Tests whether a BLOCK gives exactly one warning of the passed category. +The categories are grouped in a tree, +like it is expressed in perllexwarn. +Also see L</BUGS AND LIMITATIONS>. + + +Thanks to the grouping in a tree, +it's simple possible to test for an 'io' warning, +instead for testing for a 'closed|exec|layer|newline|pipe|unopened' warning. + +Note, that warnings occurring at compile time, +can only be caught in an eval block. So + + warning_like {eval q/"$x"; $x;/} + [qw/void uninitialized/], + "some warnings at compile time"; + +will work, +while it wouldn't work without the eval. + +Note, that it isn't possible yet, +to test for own categories, +created with warnings::register. + +=item warnings_like BLOCK ARRAYREF, TEST_NAME + +Tests to see that BLOCK gives exactly the number of the specified warnings +and all the warnings have to match in the defined order to the +passed regexes. + +Please read also the notes to warning_like as these methods are only aliases. + +Similar to C<warnings_are>, +you can test for multiple warnings via C<carp> +and for warning categories, too: + + warnings_like {foo()} + [qr/bar warning/, + qr/bar warning/, + {carped => qr/bar warning/i}, + 'io' + ], + "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 + +C<warning_is>, +C<warnings_are>, +C<warning_like>, +C<warnings_like>, +C<warnings_exist> by default. + +=head1 BUGS AND LIMITATIONS + +Category check is done as qr/category_name/. In some case this works, like for +category 'uninitialized'. For 'utf8' it does not work. Perl does not have a list +of warnings, so it is not possible to generate one for Test::Warn. +If you want to add a warning to a category, send a pull request. Modifications +should be done to %warnings_in_category. You should look into perl source to check +how warning is looking exactly. + +Please note that warnings with newlines inside are making a lot of trouble. +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. + +If a method has it's own warn handler, +overwriting C<$SIG{__WARN__}>, +my test warning methods won't get these warnings. + +The C<warning_like BLOCK CATEGORY, TEST_NAME> method isn't extremely tested. +Please use this calling style with higher attention and +tell me if you find a bug. + +=head1 TODO + +Improve this documentation. + +The code has some parts doubled - especially in the test scripts. +This is really awkward and must be changed. + +Please feel free to suggest improvements. + +=head1 SEE ALSO + +Have a look to the similar modules: L<Test::Exception>, L<Test::Trap>. + +=head1 THANKS + +Many thanks to Adrian Howard, chromatic and Michael G. Schwern, +who have given me a lot of ideas. + +=head1 AUTHOR + +Janek Schleicher, E<lt>bigj AT kamelfreund.deE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright 2002 by Janek Schleicher + +Copyright 2007-2014 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. + +=cut + + +package Test::Warn; + +use 5.006; +use strict; +use warnings; + +#use Array::Compare; +use Sub::Uplevel 0.12; + +our $VERSION = '0.30'; + +require Exporter; + +our @ISA = qw(Exporter); + +our %EXPORT_TAGS = ( 'all' => [ qw( + @EXPORT +) ] ); + +our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +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; + 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 + push @got_warning, _canonical_got_warning($called_from, shift()); + }; + uplevel 1,$block; + my $ok = _cmp_is( \@got_warning, \@exp_warning ); + $Tester->ok( $ok, $testname ); + $ok or _diag_found_warning(@got_warning), + _diag_exp_warning(@exp_warning); + return $ok; +} + + +sub warnings_like (&$;$) { + 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 + push @got_warning, _canonical_got_warning($called_from, shift()); + }; + 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 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]); +} + +sub _canonical_got_warning { + my ($called_from, $msg) = @_; + my $warn_kind = $called_from eq 'Carp' ? 'carped' : 'warn'; + my @warning_stack = split /\n/, $msg; # some stuff of uplevel is included + return {$warn_kind => $warning_stack[0]}; # return only the real message +} + +sub _canonical_exp_warning { + my ($exp) = @_; + if (ref($exp) eq 'HASH') { # could be {carped => ...} + my $to_carp = $exp->{carped} or return; # undefined message are ignored + return (ref($to_carp) eq 'ARRAY') # is {carped => [ ..., ...] } + ? map({ {carped => $_} } grep {defined $_} @$to_carp) + : +{carped => $to_carp}; + } + return {warn => $exp}; +} + +sub _cmp_got_to_exp_warning { + 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 .+ line \d+\.?$/; + return $cmp; +} + +sub _cmp_got_to_exp_warning_like { + 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)) { #qr// or '//' + my $cmp = $got_msg =~ /$re/; + return $cmp; + } else { + return Test::Warn::Categorization::warning_like_category($got_msg,$exp_msg); + } +} + + +sub _cmp_is { + my @got = @{ shift() }; + my @exp = @{ shift() }; + scalar @got == scalar @exp or return 0; + my $cmp = 1; + $cmp &&= _cmp_got_to_exp_warning($got[$_],$exp[$_]) for (0 .. $#got); + return $cmp; +} + +sub _cmp_like { + my @got = @{ shift() }; + my @exp = @{ shift() }; + scalar @got == scalar @exp or return 0; + my $cmp = 1; + $cmp &&= _cmp_got_to_exp_warning_like($got[$_],$exp[$_]) for (0 .. $#got); + return $cmp; +} + +sub _diag_found_warning { + foreach (@_) { + if (ref($_) eq 'HASH') { + ${$_}{carped} ? $Tester->diag("found carped warning: ${$_}{carped}") + : $Tester->diag("found warning: ${$_}{warn}"); + } else { + $Tester->diag( "found warning: $_" ); + } + } + $Tester->diag( "didn't find a warning" ) unless @_; +} + +sub _diag_exp_warning { + foreach (@_) { + if (ref($_) eq 'HASH') { + ${$_}{carped} ? $Tester->diag("expected to find carped warning: ${$_}{carped}") + : $Tester->diag("expected to find warning: ${$_}{warn}"); + } else { + $Tester->diag( "expected to find warning: $_" ); + } + } + $Tester->diag( "didn't expect to find a warning" ) unless @_; +} + +package Test::Warn::Categorization; + +use Carp; + +my $bits = \%warnings::Bits; +my @warnings = sort grep { + my $warn_bits = $bits->{$_}; + #!grep { $_ ne $warn_bits && ($_ & $warn_bits) eq $_ } values %$bits; +} keys %$bits; + +my %warnings_in_category = ( + 'utf8' => ['Wide character in \w+\b',], +); + +sub _warning_category_regexp { + my $category = shift; + my $category_bits = $bits->{$category} or return; + my @category_warnings + = grep { ($bits->{$_} & $category_bits) eq $bits->{$_} } @warnings; + + my @list = + map { exists $warnings_in_category{$_}? (@{ $warnings_in_category{$_}}) : ($_) } + @category_warnings; + my $re = join "|", @list; + return qr/$re/; +} + +sub warning_like_category { + my ($warning, $category) = @_; + my $re = _warning_category_regexp($category) or + carp("Unknown warning category '$category'"),return; + my $ok = $warning =~ /$re/; + return $ok; +} + +1; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/t/pod.t new/Test-Warn-0.30/t/pod.t --- old/Test-Warn-0.24/t/pod.t 2010-07-29 14:09:03.000000000 +0200 +++ new/Test-Warn-0.30/t/pod.t 1970-01-01 01:00:00.000000000 +0100 @@ -1,10 +0,0 @@ -#!perl -T - -use Test::More; -eval "use Test::Pod 1.14"; -if ($@) { - plan skip_all => "Test::Pod 1.14 required for testing POD" ; -} else { - diag("Test::Pod version $Test::Pod::VERSION"); -} -all_pod_files_ok(); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/t/warnings_are.t new/Test-Warn-0.30/t/warnings_are.t --- old/Test-Warn-0.24/t/warnings_are.t 2012-02-24 22:52:07.000000000 +0100 +++ new/Test-Warn-0.30/t/warnings_are.t 2014-01-31 00:21:42.000000000 +0100 @@ -25,8 +25,8 @@ [ "ok", ["warning 1","warning 2"], ["warning 1", "warning 2"], "more than one warning (standard ok)"], [ "ok", ["warning 1","warning 1"], ["warning 1", "warning 1"], "more than one warning (two similar warnings)"], ["not ok", ["warning 1","warning 2"], ["warning 2", "warning 1"], "more than one warning (different order)"], - [ "ok", [('01' .. '99')], [('01' .. '99')], "many warnings ok"], - ["not ok", [('01' .. '99')], [('01' .. '99'), '100'], "many, but diff. warnings"] + [ "ok", [ 1 .. 20 ], [ 1 .. 20 ], "many warnings ok"], + ["not ok", [ 1 .. 20 ], [ 1 .. 21 ], "many, but diff. warnings"] ); use Test::Builder::Tester tests => TESTS() * SUBTESTS_PER_TESTS; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Test-Warn-0.24/t/warnings_like.t new/Test-Warn-0.30/t/warnings_like.t --- old/Test-Warn-0.24/t/warnings_like.t 2012-02-24 22:52:16.000000000 +0100 +++ new/Test-Warn-0.30/t/warnings_like.t 2014-01-31 00:21:42.000000000 +0100 @@ -25,8 +25,8 @@ [ "ok", ["warning 1","warning 2"], ["warning 1", "warning 2"], "more than one warning (standard ok)"], [ "ok", ["warning 1","warning 1"], ["warning 1", "warning 1"], "more than one warning (two similar warnings)"], ["not ok", ["warning 1","warning 2"], ["warning 2", "warning 1"], "more than one warning (different order)"], - [ "ok", [('01' .. '99')], [('01' .. '99')], "many warnings ok"], - ["not ok", [('01' .. '99')], [('01' .. '99'), '100'], "many, but diff. warnings"] + [ "ok", [ 1 .. 20 ], [ 1 .. 20 ], "many warnings ok"], + ["not ok", [ 1 .. 20 ], [ 1 .. 21 ], "many, but diff. warnings"] ); use constant SUBTESTS_PER_TESTS => 32; -- To unsubscribe, e-mail: opensuse-commit+unsubscr...@opensuse.org For additional commands, e-mail: opensuse-commit+h...@opensuse.org
