Test-Exception-LessClever-0.009/000755 000766 000024 00000000000 13013665650 016722 5ustar00etherstaff000000 000000 Test-Exception-LessClever-0.009/Changes000644 000766 000024 00000000272 13013665551 020216 0ustar00etherstaff000000 000000 Revision history for Test-Exception-LessClever 0.009 2016-11-18 - switched from Module::Build to ExtUtils::MakeMaker - added deprecation warning when module is loaded Test-Exception-LessClever-0.009/MANIFEST000644 000766 000024 00000000205 13013665647 020056 0ustar00etherstaff000000 000000 Changes lib/Test/Exception/LessClever.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml README t/tests.t Test-Exception-LessClever-0.009/MANIFEST.SKIP000644 000766 000024 00000002356 13013665604 020625 0ustar00etherstaff000000 000000 #!start included /Volumes/amaretto/Users/ether/perl5/perlbrew/perls/25.6/lib/5.25.6/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this \b_eumm/ # 7.05_05 and above # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # and Module::Build::Tiny generated files \b_build_params$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ \..*\.sw.?$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b \bcovered\b # Avoid prove files \B\.prove$ # Avoid MYMETA files ^MYMETA\. #!end included /Volumes/amaretto/Users/ether/perl5/perlbrew/perls/25.6/lib/5.25.6/ExtUtils/MANIFEST.SKIP # Avoid archives of this distribution \bTest-Exception-LessClever-[\d\.\_]+ Test-Exception-LessClever-0.009/META.json000644 000766 000024 00000003400 13013665650 020340 0ustar00etherstaff000000 000000 { "abstract" : "(DEPRECATED) Test::Exception simplified", "author" : [ "Chad Granum " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Test-Exception-LessClever", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Exporter" : "0", "Test::Builder" : "0", "base" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Mock::Quick" : "1.100", "Test::Builder::Tester" : "0", "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/exodist/Test-Exception-LessClever/issues" }, "homepage" : "https://github.com/exodist/Test-Exception-LessClever", "repository" : { "type" : "git", "url" : "https://github.com/exodist/Test-Exception-LessClever.git", "web" : "https://github.com/exodist/Test-Exception-LessClever" } }, "version" : "0.009", "x_IRC" : "irc://irc.perl.org/#perl-qa", "x_MailingList" : "http://lists.perl.org/list/perl-qa.html", "x_authority" : "cpan:EXODIST", "x_deprecated" : 1, "x_serialization_backend" : "JSON::MaybeXS version 1.003008" } Test-Exception-LessClever-0.009/META.yml000644 000766 000024 00000002055 13013665647 020203 0ustar00etherstaff000000 000000 --- abstract: '(DEPRECATED) Test::Exception simplified' author: - 'Chad Granum ' build_requires: Mock::Quick: '1.100' Test::Builder::Tester: '0' Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Exception-LessClever no_index: directory: - t - inc requires: Carp: '0' Exporter: '0' Test::Builder: '0' base: '0' perl: '5.006' strict: '0' warnings: '0' resources: bugtracker: https://github.com/exodist/Test-Exception-LessClever/issues homepage: https://github.com/exodist/Test-Exception-LessClever repository: https://github.com/exodist/Test-Exception-LessClever.git version: '0.009' x_IRC: irc://irc.perl.org/#perl-qa x_MailingList: http://lists.perl.org/list/perl-qa.html x_authority: cpan:EXODIST x_deprecated: 1 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Test-Exception-LessClever-0.009/Makefile.PL000644 000766 000024 00000006405 13013665501 020674 0ustar00etherstaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( NAME => 'Test::Exception::LessClever', AUTHOR => 'Chad Granum ', LICENSE => 'perl_5', ABSTRACT_FROM => 'lib/Test/Exception/LessClever.pm', VERSION_FROM => 'lib/Test/Exception/LessClever.pm', META_MERGE => { 'meta-spec' => { version => 2 }, dynamic_config => 0, resources => { repository => { url => 'https://github.com/exodist/Test-Exception-LessClever.git', web => 'https://github.com/exodist/Test-Exception-LessClever', type => 'git', }, homepage => 'https://github.com/exodist/Test-Exception-LessClever', bugtracker => { web => 'https://github.com/exodist/Test-Exception-LessClever/issues', }, }, x_IRC => 'irc://irc.perl.org/#perl-qa', x_MailingList => 'http://lists.perl.org/list/perl-qa.html', x_authority => 'cpan:EXODIST', x_deprecated => 1, }, META_ADD => { 'meta-spec' => { version => 2 }, prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => '0', }, }, runtime => { requires => { 'Carp' => '0', 'Exporter' => '0', 'Test::Builder' => '0', 'base' => '0', 'strict' => '0', 'warnings' => '0', 'perl' => '5.006', }, }, test => { requires => { 'Mock::Quick' => '1.100', 'Test::Builder::Tester' => '0', 'Test::More' => '0.88', }, }, }, }, ); my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; next unless exists $WriteMakefileArgs{META_ADD}{prereqs}{$_} or exists $WriteMakefileArgs{$key}; my $r = $WriteMakefileArgs{$key} = { %{$WriteMakefileArgs{META_ADD}{prereqs}{$_}{requires} || {}}, %{delete $WriteMakefileArgs{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } # dynamic prereqs get added here. $WriteMakefileArgs{MIN_PERL_VERSION} = delete $WriteMakefileArgs{PREREQ_PM}{perl} || 0; die 'attention developer: you need to do a sane meta merge here!' if keys %{$WriteMakefileArgs{BUILD_REQUIRES}}; $WriteMakefileArgs{BUILD_REQUIRES} = { %{$WriteMakefileArgs{BUILD_REQUIRES} || {}}, %{delete $WriteMakefileArgs{TEST_REQUIRES}} } if $eumm_version < 6.63_03; $WriteMakefileArgs{PREREQ_PM} = { %{$WriteMakefileArgs{PREREQ_PM}}, %{delete $WriteMakefileArgs{BUILD_REQUIRES}} } if $eumm_version < 6.55_01; delete $WriteMakefileArgs{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; delete $WriteMakefileArgs{MIN_PERL_VERSION} if $eumm_version < 6.48; delete @WriteMakefileArgs{qw(META_ADD META_MERGE)} if $eumm_version < 6.46; delete $WriteMakefileArgs{LICENSE} if $eumm_version < 6.31; WriteMakefile(%WriteMakefileArgs); # pod2text is in https://metacpan.org/release/podlators system("pod2text $WriteMakefileArgs{VERSION_FROM} > README") if -f '.gitignore' and (not -e 'README' or (stat('README'))[9] < (stat($WriteMakefileArgs{VERSION_FROM}))[9]); Test-Exception-LessClever-0.009/README000644 000766 000024 00000006712 13013665604 017607 0ustar00etherstaff000000 000000 NAME Test::Exception::LessClever - (DEPRECATED) Test::Exception simplified DEPRECATION NOTICE *** This module is deprecated: please do not use it! *** An alternative to Test::Exception that is much simpler. This alternative does not use fancy stack tricks to hide itself. The idea here is to keep it simple. This also solves the Test::Exception bug where some dies will be hidden when a DESTROY method calls eval. If a DESTROY method masks $@ a warning will be generated as well. WHY REWRITE TEST-EXCEPTION Here is an IRC log. wtf? Bizarre copy of HASH in sassign at /usr/lib64/perl5/5.10.1/Carp/Heavy.pm line 104 hmm, it doesn't happen when I step through the debugger, that sure is helpful yessir hmm, throws_ok or dies_ok { stuff that croaks in a package used by the one being tested }, at least in this case causes that error. If I change it to eval {}; ok( $@ ); like( $@, qr// ); it works fine Ah-Ha, earlier when I mentioned I stopped using throws_ok because of something I could not remember, this was it, I stumbled on it again! probably because throws_ok tries to do clever things to fiddle with the call stack to make it appear as though its guts are not being called less clever would be more useful SYNOPSIS Pretty much a clone of Test::Exception Refer to those docs for more details. use Test::More; use Test::Exception; dies_ok { die( 'xxx' )} "Should die"; lives_ok { 1 } "Should live"; throws_ok { die( 'xxx' )} qr/xxx/, "Throws 'xxx'"; lives_and { ok( 1, "We did not die" )} "Ooops we died"; done_testing; EXPORTABLE FUNCTIONS $status = live_or_die( sub { ... }, $name ) ($status, $msg) = live_or_die( sub { ... }, $name ) Check if the code lives or dies. In scalar context returns true or false. In array context returns the same true or false with the error message. If the return is true the error message will be something along the lines of 'did not die' but this may change in the future. Will generate a warning if the test dies, $@ is empty AND called in array context. This usually occurs when an objects DESTROY method calls eval and masks $@. *NOT EXPORTED BY DEFAULT* lives_ok( sub { ... }, $name ) Test passes if the sub does not die, false if it does. dies_ok( sub { ... }, $name ) Test passes if the sub dies, false if it does not. throws_ok( sub { ... }, qr/message/, $name ) Check that the sub dies, and that it throws an error that matches the regex. Test fails is the sub does not die, or if the message does not match the regex. lives_and( sub {...}, $name ) Fails with $name if the sub dies, otherwise is passive. This is useful for running a test that could die. If it dies there is a failure, if it lives it is responsible for itself. SEE ALSO * Test::Fatal * Test::Exception AUTHORS Chad Granum exodist7@gmail.com COPYRIGHT Copyright (C) 2010 Chad Granum Test-Exception-LessClever is free software; Standard perl licence. Test-Exception-LessClever is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details. Test-Exception-LessClever-0.009/lib/000755 000766 000024 00000000000 13013665647 017476 5ustar00etherstaff000000 000000 Test-Exception-LessClever-0.009/t/000755 000766 000024 00000000000 13013665647 017173 5ustar00etherstaff000000 000000 Test-Exception-LessClever-0.009/t/tests.t000644 000766 000024 00000006602 12501353434 020513 0ustar00etherstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::Builder::Tester; use Test::More; use Mock::Quick qw/qobj qmeth/; our $CLASS; BEGIN { test_out( 'ok 1 - use Test::Exception::LessClever;' ); $CLASS = 'Test::Exception::LessClever'; use_ok( $CLASS, qw/lives_ok dies_ok throws_ok lives_and live_or_die/ ); } my $program = quotemeta($0); test_out( "not ok 2 - dies_ok fail" ); test_fail(+1); dies_ok { 1 } "dies_ok fail"; test_out( "not ok 3 - lives_ok fail" ); test_fail(+1); lives_ok { die( 'xxx' )} 'lives_ok fail'; test_err( "# Test did not die as expected at $0 line 29." ); test_out( "not ok 4 - throws_ok doesn't die" ); test_fail(+1); throws_ok { 1 } qr/xxx/, "throws_ok doesn't die"; test_out( "not ok 5 - throws_ok error doesn't match" ); test_fail(+7); if ( $^V and $^V ge '5.13.6' ) { test_err( "# $0 line 39:\n# Wanted: (?^:YYY)\n# Got: XXX at $0 line 39." ); } else { test_err( "# $0 line 39:\n# Wanted: (?-xism:YYY)\n# Got: XXX at $0 line 39." ); } throws_ok { die "XXX" } qr/YYY/, "throws_ok error doesn't match"; test_err( "# Test unexpectedly died: 'xxx at $0 line 44.' at $0 line 44." ); test_out( "not ok 6 - did not live to test" ); test_fail(+1); lives_and { die 'xxx' } "did not live to test"; test_test "Test output was as desired"; ###### # # End of failure tests # ###### my $ret = live_or_die( sub { die( 'apple' ) }); ok( !$ret, "Registered a die" ); ($ret, my $error) = live_or_die( sub { die( 'apple' ) }); ok( !$ret, "Registered a die" ); like( $error, qr/apple/, "Got error" ); $ret = live_or_die( sub { 1 }); ok( $ret, "Registered a live" ); ($ret, my $msg) = live_or_die( sub { 1; }); ok( $ret, "Registered a live" ); like( $msg, qr/did not die/, "Got msg" ); if ( $^V and $^V ge '5.13.0' ) { note( "Perl version $^V does not suffer from die in eval edge case, skipping..." ); } else { my @warn; local $SIG{ __WARN__ } = sub { push @warn => @_ }; ($ret, $error) = live_or_die( sub { my $obj = qobj( DESTROY => qmeth { eval { 1 }} ); die( 'apple' ); $obj->x; }); ok( !$ret, "Registered a die despite eval in DESTROY" ); ok( !$error, "Error was masked by eval in DESTROY" ); like( $warn[0], qr/ code \s died \s as \s expected, \s however \s the \s error \s is \s masked\. \s This \s can \s occur \s when \s an \s object's \s DESTROY\(\) \s method \s calls \s eval \s at \s $program /x, "Warn of edge case" ); @warn = (); $ret = live_or_die( sub { my $obj = qobj( DESTROY => qmeth { eval { 1 }} ); die( 'apple' ); $obj->x; }); ok( !$ret, "Registered a die despite eval in DESTROY" ); ok( !@warn, "No warning when error is not requested" ); @warn = (); throws_ok { my $obj = qobj( DESTROY => qmeth { eval { 1 }} ); die( 'xxx' ); $obj->x; } qr/^$/, "Throw edge case"; like( $warn[0], qr/ code \s died \s as \s expected, \s however \s the \s error \s is \s masked\. \s This \s can \s occur \s when \s an \s object's \s DESTROY\(\) \s method \s calls \s eval \s at \s $program /x, "Warn of edge case" ); } lives_ok { 1 } "Simple living sub"; dies_ok { die( 'xxx' )} "Simple dying sub"; throws_ok { die( 'xxx' )} qr/xxx/, "Simple throw"; lives_and { ok( 1, "Blah" )} "Test did not die"; done_testing; Test-Exception-LessClever-0.009/lib/Test/000755 000766 000024 00000000000 13013665647 020415 5ustar00etherstaff000000 000000 Test-Exception-LessClever-0.009/lib/Test/Exception/000755 000766 000024 00000000000 13013665647 022353 5ustar00etherstaff000000 000000 Test-Exception-LessClever-0.009/lib/Test/Exception/LessClever.pm000644 000766 000024 00000012445 13013665551 024760 0ustar00etherstaff000000 000000 package Test::Exception::LessClever; use strict; use warnings; use base 'Exporter'; use Test::Builder; use Carp qw/carp/; #{{{ POD =head1 NAME Test::Exception::LessClever - (DEPRECATED) Test::Exception simplified =head1 DEPRECATION NOTICE *** This module is deprecated: please do not use it! *** An alternative to L that is much simpler. This alternative does not use fancy stack tricks to hide itself. The idea here is to keep it simple. This also solves the Test::Exception bug where some dies will be hidden when a DESTROY method calls eval. If a DESTROY method masks $@ a warning will be generated as well. =head1 WHY REWRITE TEST-EXCEPTION Here is an IRC log. wtf? Bizarre copy of HASH in sassign at /usr/lib64/perl5/5.10.1/Carp/Heavy.pm line 104 hmm, it doesn't happen when I step through the debugger, that sure is helpful yessir hmm, throws_ok or dies_ok { stuff that croaks in a package used by the one being tested }, at least in this case causes that error. If I change it to eval {}; ok( $@ ); like( $@, qr// ); it works fine Ah-Ha, earlier when I mentioned I stopped using throws_ok because of something I could not remember, this was it, I stumbled on it again! probably because throws_ok tries to do clever things to fiddle with the call stack to make it appear as though its guts are not being called less clever would be more useful =head1 SYNOPSIS Pretty much a clone of L Refer to those docs for more details. use Test::More; use Test::Exception; dies_ok { die( 'xxx' )} "Should die"; lives_ok { 1 } "Should live"; throws_ok { die( 'xxx' )} qr/xxx/, "Throws 'xxx'"; lives_and { ok( 1, "We did not die" )} "Ooops we died"; done_testing; =head1 EXPORTABLE FUNCTIONS =over 4 =cut #}}} our @EXPORT_OK = qw/live_or_die/; our @EXPORT = qw/lives_ok dies_ok throws_ok lives_and/; our @CARP_NOT = ( __PACKAGE__ ); our $TB = Test::Builder->new; our $VERSION = "0.009"; warnings::warnif('deprecated', '!!! Test::Exception::LessClever is deprecated'); =item $status = live_or_die( sub { ... }, $name ) =item ($status, $msg) = live_or_die( sub { ... }, $name ) Check if the code lives or dies. In scalar context returns true or false. In array context returns the same true or false with the error message. If the return is true the error message will be something along the lines of 'did not die' but this may change in the future. Will generate a warning if the test dies, $@ is empty AND called in array context. This usually occurs when an objects DESTROY method calls eval and masks $@. *NOT EXPORTED BY DEFAULT* =cut sub live_or_die { my ( $code ) = @_; my $return = eval { $code->(); 'did not die' } || "died"; my $msg = $@; if ( $return eq 'did not die' ) { return ( 1, $return ) if wantarray; return 1; } else { return 0 unless wantarray; if ( !$msg ) { carp "code died as expected, however the error is masked. This" . " can occur when an object's DESTROY() method calls eval"; } return ( 0, $msg ); } } =item lives_ok( sub { ... }, $name ) Test passes if the sub does not die, false if it does. =cut sub lives_ok(&;$) { my ( $code, $name ) = @_; my $ok = live_or_die( $code ); $TB->ok( $ok, $name ); return $ok; } =item dies_ok( sub { ... }, $name ) Test passes if the sub dies, false if it does not. =cut sub dies_ok(&;$) { my ( $code, $name ) = @_; my $ok = live_or_die( $code ); $TB->ok( !$ok, $name ); return !$ok; } =item throws_ok( sub { ... }, qr/message/, $name ) Check that the sub dies, and that it throws an error that matches the regex. Test fails is the sub does not die, or if the message does not match the regex. =cut sub throws_ok(&$;$) { my ( $code, $reg, $name ) = @_; my ( $ok, $msg ) = live_or_die( $code ); my ( $pkg, $file, $number ) = caller; # If we lived if ( $ok ) { $TB->diag( "Test did not die as expected at $file line $number." ); return $TB->ok( !$ok, $name ); } my $match = $msg =~ $reg ? 1 : 0; $TB->ok( $match, $name ); $TB->diag( "$file line $number:\n Wanted: $reg\n Got: $msg" ) unless( $match ); return $match; } =item lives_and( sub {...}, $name ) Fails with $name if the sub dies, otherwise is passive. This is useful for running a test that could die. If it dies there is a failure, if it lives it is responsible for itself. =cut sub lives_and(&;$) { my ( $code, $name ) = @_; my ( $ok, $msg )= live_or_die( $code ); my ( $pkg, $file, $number ) = caller; chomp( $msg ); $msg =~ s/\n/ /g; $TB->diag( "Test unexpectedly died: '$msg' at $file line $number." ) unless $ok; $TB->ok( $ok, $name ) if !$ok; return $ok; } 1; __END__ =back =head1 SEE ALSO =over 4 =item * L =item * L =back =head1 AUTHORS Chad Granum L =head1 COPYRIGHT Copyright (C) 2010 Chad Granum Test-Exception-LessClever is free software; Standard perl licence. Test-Exception-LessClever is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the license for more details.