Carp-Assert-0.20/0000755000076500007650000000000010547340515013501 5ustar schwernschwernCarp-Assert-0.20/Changes0000644000076500007650000000472310547340443015002 0ustar schwernschwern0.20 Thu Jan 4 19:08:00 PST 2007 - The tests will no longer fail should the user have NDEBUG or PERL_NDEBUG environment variables set [rt.cpan.org 21170] - Update the license link to point to the whole Perl license, not just the Artistic license. 0.19 Tue Jan 2 15:13:09 PST 2007 - Fixed installation for those who have Pod::Tests but pod2test is not in their PATH as some CPAN shell configurations do. 0.18 Tue Mar 2 16:02:23 PST 2004 - Added copyright and license info - Made affirm's code dumping code safe on perl where B::Deparse isn't quite up to the job. - Some minor grammar nits from David Wheeler. 0.17 Mon Oct 1 16:43:00 EDT 2001 * Wouldn't install without Test::Inline. Removed that dependency. 0.16 Sat Sep 8 20:21:58 EDT 2001 * Now works all the way back to 5.004! * Forgot to add a dependency on Test::More - Added embedded tests 0.15 Tue Jun 12 17:59:03 EDT 2001 - Now using B::Deparse * Added affirm() - Tweaked the assertion message a bit - Added more docs about debugging vs production - Added an EFFICIENCY section. 0.14 Sun Mar 11 23:15:24 GMT 2001 * Added $name argument to assert() 0.13 Fri Feb 9 15:28:23 GMT 2001 - Added shouldn't(). 0.12 Tue Feb 6 11:58:11 GMT 2001 - Added PERL_NDEBUG environment variable, same as NDEBUG * added should() and shouldnt() * Fixed :NDEBUG/no Carp::Assert to completely shut off assertions. 0.11 Fri Jun 2 13:14:32 EDT 2000 - Added NDEBUG environment variable to shut off all assertions. - Added a test for NDEBUG. 0.10 Mon Mar 13 09:31:12 EST 2000 - Removed uses of constant.pm, reduces load time a bit. * C< no Carp::Assert > is now the way to shut off assertions. 0.08 Thu Dec 23 13:04:55 EST 1999 - Made the assert error a smidge nicer looking. - Added some docs on what an assert error means. 0.07 Wed Oct 13 12:08:43 EDT 1999 - s/assertation/assertion/g (Thanks to John Porter) - improved the synopsis a smidge - added another example of bad usage - delayed loading of Carp until an assert() fails 0.06 Thu Apr 29 16:58:32 1999 - added INSTALL and README 0.05 Wed Apr 28 15:45:45 1999 - tests fixed - confirmed at assert compiles out properly 0.04 Wed Apr 28 15:26:31 1999 * Devel::Assert is now Carp::Assert * simplified the interface greatly. - never distributed 0.01 Tue Jan 5 18:40:21 1999 - original version; created by h2xs 1.18 Carp-Assert-0.20/INSTALL0000644000076500007650000000101110534645133014523 0ustar schwernschwernWHAT IS THIS? This is Carp::Assert, a perl module. Please see the README that comes with this distribution. HOW DO I INSTALL IT? To install this module, cd to the directory that contains this README file and type the following: perl Makefile.PL make make test make install To install this module into a specific directory, do: perl Makefile.PL PREFIX=/name/of/the/directory ...the rest is the same... Please also read the perlmodinstall man page, if available. WHAT MODULES DO I NEED? Carp Carp-Assert-0.20/lib/0000755000076500007650000000000010547340463014251 5ustar schwernschwernCarp-Assert-0.20/lib/Carp/0000755000076500007650000000000010547340463015136 5ustar schwernschwernCarp-Assert-0.20/lib/Carp/Assert.pm0000644000076500007650000003660710547340352016746 0ustar schwernschwernpackage Carp::Assert; require 5.004; use strict qw(subs vars); use Exporter; use vars qw(@ISA $VERSION %EXPORT_TAGS); BEGIN { $VERSION = '0.20'; @ISA = qw(Exporter); %EXPORT_TAGS = ( NDEBUG => [qw(assert affirm should shouldnt DEBUG)], ); $EXPORT_TAGS{DEBUG} = $EXPORT_TAGS{NDEBUG}; Exporter::export_tags(qw(NDEBUG DEBUG)); } # constant.pm, alas, adds too much load time (yes, I benchmarked it) sub REAL_DEBUG () { 1 } # CONSTANT sub NDEBUG () { 0 } # CONSTANT # Export the proper DEBUG flag according to if :NDEBUG is set. # Also export noop versions of our routines if NDEBUG sub noop { undef } sub noop_affirm (&;$) { undef }; sub import { my $env_ndebug = exists $ENV{PERL_NDEBUG} ? $ENV{PERL_NDEBUG} : $ENV{'NDEBUG'}; if( grep(/^:NDEBUG$/, @_) or $env_ndebug ) { my $caller = caller; foreach my $func (grep !/^DEBUG$/, @{$EXPORT_TAGS{'NDEBUG'}}) { if( $func eq 'affirm' ) { *{$caller.'::'.$func} = \&noop_affirm; } else { *{$caller.'::'.$func} = \&noop; } } *{$caller.'::DEBUG'} = \&NDEBUG; } else { *DEBUG = *REAL_DEBUG; Carp::Assert->_export_to_level(1, @_); } } # 5.004's Exporter doesn't have export_to_level. sub _export_to_level { my $pkg = shift; my $level = shift; (undef) = shift; # XXX redundant arg my $callpkg = caller($level); $pkg->export($callpkg, @_); } sub unimport { *DEBUG = *NDEBUG; push @_, ':NDEBUG'; goto &import; } # Can't call confess() here or the stack trace will be wrong. sub _fail_msg { my($name) = shift; my $msg = 'Assertion'; $msg .= " ($name)" if defined $name; $msg .= " failed!\n"; return $msg; } =head1 NAME Carp::Assert - executable comments =head1 SYNOPSIS # Assertions are on. use Carp::Assert; $next_sunrise_time = sunrise(); # Assert that the sun must rise in the next 24 hours. assert(($next_sunrise_time - time) < 24*60*60) if DEBUG; # Assert that your customer's primary credit card is active affirm { my @cards = @{$customer->credit_cards}; $cards[0]->is_active; }; # Assertions are off. no Carp::Assert; $next_pres = divine_next_president(); # Assert that if you predict Dan Quayle will be the next president # your crystal ball might need some polishing. However, since # assertions are off, IT COULD HAPPEN! shouldnt($next_pres, 'Dan Quayle') if DEBUG; =head1 DESCRIPTION =begin testing BEGIN { local %ENV = %ENV; delete @ENV{qw(PERL_NDEBUG NDEBUG)}; require Carp::Assert; Carp::Assert->import; } local %ENV = %ENV; delete @ENV{qw(PERL_NDEBUG NDEBUG)}; =end testing "We are ready for any unforseen event that may or may not occur." - Dan Quayle Carp::Assert is intended for a purpose like the ANSI C library assert.h. If you're already familiar with assert.h, then you can probably skip this and go straight to the FUNCTIONS section. Assertions are the explict expressions of your assumptions about the reality your program is expected to deal with, and a declaration of those which it is not. They are used to prevent your program from blissfully processing garbage inputs (garbage in, garbage out becomes garbage in, error out) and to tell you when you've produced garbage output. (If I was going to be a cynic about Perl and the user nature, I'd say there are no user inputs but garbage, and Perl produces nothing but...) An assertion is used to prevent the impossible from being asked of your code, or at least tell you when it does. For example: =for example begin # Take the square root of a number. sub my_sqrt { my($num) = shift; # the square root of a negative number is imaginary. assert($num >= 0); return sqrt $num; } =for example end =for example_testing is( my_sqrt(4), 2, 'my_sqrt example with good input' ); ok( !eval{ my_sqrt(-1); 1 }, ' and pukes on bad' ); The assertion will warn you if a negative number was handed to your subroutine, a reality the routine has no intention of dealing with. An assertion should also be used as something of a reality check, to make sure what your code just did really did happen: open(FILE, $filename) || die $!; @stuff = ; @stuff = do_something(@stuff); # I should have some stuff. assert(@stuff > 0); The assertion makes sure you have some @stuff at the end. Maybe the file was empty, maybe do_something() returned an empty list... either way, the assert() will give you a clue as to where the problem lies, rather than 50 lines down at when you wonder why your program isn't printing anything. Since assertions are designed for debugging and will remove themelves from production code, your assertions should be carefully crafted so as to not have any side-effects, change any variables, or otherwise have any effect on your program. Here is an example of a bad assertation: assert($error = 1 if $king ne 'Henry'); # Bad! It sets an error flag which may then be used somewhere else in your program. When you shut off your assertions with the $DEBUG flag, $error will no longer be set. Here's another example of B use: assert($next_pres ne 'Dan Quayle' or goto Canada); # Bad! This assertion has the side effect of moving to Canada should it fail. This is a very bad assertion since error handling should not be placed in an assertion, nor should it have side-effects. In short, an assertion is an executable comment. For instance, instead of writing this # $life ends with a '!' $life = begin_life(); you'd replace the comment with an assertion which B the comment. $life = begin_life(); assert( $life =~ /!$/ ); =for testing my $life = 'Whimper!'; ok( eval { assert( $life =~ /!$/ ); 1 }, 'life ends with a bang' ); =head1 FUNCTIONS =over 4 =item B assert(EXPR) if DEBUG; assert(EXPR, $name) if DEBUG; assert's functionality is effected by compile time value of the DEBUG constant, controlled by saying C or C. In the former case, assert will function as below. Otherwise, the assert function will compile itself out of the program. See L for details. =for testing { package Some::Other; no Carp::Assert; ::ok( eval { assert(0) if DEBUG; 1 } ); } Give assert an expression, assert will Carp::confess() if that expression is false, otherwise it does nothing. (DO NOT use the return value of assert for anything, I mean it... really!). =for testing ok( eval { assert(1); 1 } ); ok( !eval { assert(0); 1 } ); The error from assert will look something like this: Assertion failed! Carp::Assert::assert(0) called at prog line 23 main::foo called at prog line 50 =for testing eval { assert(0) }; like( $@, '/^Assertion failed!/', 'error format' ); like( $@, '/Carp::Assert::assert\(0\) called at/', ' with stack trace' ); Indicating that in the file "prog" an assert failed inside the function main::foo() on line 23 and that foo() was in turn called from line 50 in the same file. If given a $name, assert() will incorporate this into your error message, giving users something of a better idea what's going on. assert( Dogs->isa('People'), 'Dogs are people, too!' ) if DEBUG; # Result - "Assertion (Dogs are people, too!) failed!" =for testing eval { assert( Dogs->isa('People'), 'Dogs are people, too!' ); }; like( $@, '/^Assertion \(Dogs are people, too!\) failed!/', 'names' ); =cut sub assert ($;$) { unless($_[0]) { require Carp; Carp::confess( _fail_msg($_[1]) ); } return undef; } =item B affirm BLOCK if DEBUG; affirm BLOCK $name if DEBUG; Very similar to assert(), but instead of taking just a simple expression it takes an entire block of code and evaluates it to make sure its true. This can allow more complicated assertions than assert() can without letting the debugging code leak out into production and without having to smash together several statements into one. =for example begin affirm { my $customer = Customer->new($customerid); my @cards = $customer->credit_cards; grep { $_->is_active } @cards; } "Our customer has an active credit card"; =for example end =for testing my $foo = 1; my $bar = 2; eval { affirm { $foo == $bar } }; like( $@, '/\$foo == \$bar/' ); affirm() also has the nice side effect that if you forgot the C suffix its arguments will not be evaluated at all. This can be nice if you stick affirm()s with expensive checks into hot loops and other time-sensitive parts of your program. If the $name is left off and your Perl version is 5.6 or higher the affirm() diagnostics will include the code begin affirmed. =cut sub affirm (&;$) { unless( eval { &{$_[0]}; } ) { my $name = $_[1]; if( !defined $name ) { eval { require B::Deparse; $name = B::Deparse->new->coderef2text($_[0]); }; $name = 'code display non-functional on this version of Perl, sorry' if $@; } require Carp; Carp::confess( _fail_msg($name) ); } return undef; } =item B =item B should ($this, $shouldbe) if DEBUG; shouldnt($this, $shouldntbe) if DEBUG; Similar to assert(), it is specially for simple "this should be that" or "this should be anything but that" style of assertions. Due to Perl's lack of a good macro system, assert() can only report where something failed, but it can't report I failed or I. should() and shouldnt() can produce more informative error messages: Assertion ('this' should be 'that'!) failed! Carp::Assert::should('this', 'that') called at moof line 29 main::foo() called at moof line 58 So this: should($this, $that) if DEBUG; is similar to this: assert($this eq $that) if DEBUG; except for the better error message. Currently, should() and shouldnt() can only do simple eq and ne tests (respectively). Future versions may allow regexes. =cut sub should ($$) { unless($_[0] eq $_[1]) { require Carp; &Carp::confess( _fail_msg("'$_[0]' should be '$_[1]'!") ); } return undef; } sub shouldnt ($$) { unless($_[0] ne $_[1]) { require Carp; &Carp::confess( _fail_msg("'$_[0]' shouldn't be that!") ); } return undef; } # Sorry, I couldn't resist. sub shouldn't ($$) { # emacs cperl-mode madness #' sub { my $env_ndebug = exists $ENV{PERL_NDEBUG} ? $ENV{PERL_NDEBUG} : $ENV{'NDEBUG'}; if( $env_ndebug ) { return undef; } else { shouldnt($_[0], $_[1]); } } =back =head1 Debugging vs Production Because assertions are extra code and because it is sometimes necessary to place them in 'hot' portions of your code where speed is paramount, Carp::Assert provides the option to remove its assert() calls from your program. So, we provide a way to force Perl to inline the switched off assert() routine, thereby removing almost all performance impact on your production code. no Carp::Assert; # assertions are off. assert(1==1) if DEBUG; DEBUG is a constant set to 0. Adding the 'if DEBUG' condition on your assert() call gives perl the cue to go ahead and remove assert() call from your program entirely, since the if conditional will always be false. # With C the assert() has no impact. for (1..100) { assert( do_some_really_time_consuming_check ) if DEBUG; } If C gets too annoying, you can always use affirm(). # Once again, affirm() has (almost) no impact with C for (1..100) { affirm { do_some_really_time_consuming_check }; } Another way to switch off all asserts, system wide, is to define the NDEBUG or the PERL_NDEBUG environment variable. You can safely leave out the "if DEBUG" part, but then your assert() function will always execute (and its arguments evaluated and time spent). To get around this, use affirm(). You still have the overhead of calling a function but at least its arguments will not be evaluated. =head1 Differences from ANSI C assert() is intended to act like the function from ANSI C fame. Unfortunately, due to Perl's lack of macros or strong inlining, it's not nearly as unobtrusive. Well, the obvious one is the "if DEBUG" part. This is cleanest way I could think of to cause each assert() call and its arguments to be removed from the program at compile-time, like the ANSI C macro does. Also, this version of assert does not report the statement which failed, just the line number and call frame via Carp::confess. You can't do C because $a and $b will probably be lexical, and thus unavailable to assert(). But with Perl, unlike C, you always have the source to look through, so the need isn't as great. =head1 EFFICIENCY With C (or NDEBUG) and using the C suffixes on all your assertions, Carp::Assert has almost no impact on your production code. I say almost because it does still add some load-time to your code (I've tried to reduce this as much as possible). If you forget the C on an C, C or C, its arguments are still evaluated and thus will impact your code. You'll also have the extra overhead of calling a subroutine (even if that subroutine does nothing). Forgetting the C on an C is not so bad. While you still have the overhead of calling a subroutine (one that does nothing) it will B evaluate its code block and that can save alot. Try to remember the B. =head1 ENVIRONMENT =over 4 =item NDEBUG Defining NDEBUG switches off all assertions. It has the same effect as changing "use Carp::Assert" to "no Carp::Assert" but it effects all code. =item PERL_NDEBUG Same as NDEBUG and will override it. Its provided to give you something which won't conflict with any C programs you might be working on at the same time. =back =head1 BUGS, CAVETS and other MUSINGS =head2 Conflicts with C The C module exports an C routine which will conflict with C if both are used in the same namespace. If you are using both together, prevent C from exporting like so: use POSIX (); use Carp::Assert; Since C exports way too much, you should be using it like that anyway. =head2 C and C<$^S> affirm() mucks with the expression's caller and it is run in an eval so anything that checks $^S will be wrong. =head2 C Yes, there is a C routine. It mostly works, but you B put the C after it. =head2 missing C It would be nice if we could warn about missing C. =head1 SEE ALSO L is a new module available in 5.9.0 which provides assertions which can be enabled/disabled at compile time for real, no C necessary. =head1 COPYRIGHT Copyright 2001-2007 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =head1 AUTHOR Michael G Schwern =cut return q|You don't just EAT the largest turnip in the world!|; Carp-Assert-0.20/Makefile.PL0000644000076500007650000000404710545606516015464 0ustar schwernschwernuse ExtUtils::MakeMaker; warn "Carp::Assert likes to have B::Deparse but can't find it.\n" unless eval { require B::Deparse }; WriteMakefile( NAME => 'Carp::Assert', VERSION_FROM => 'lib/Carp/Assert.pm', # finds $VERSION PREREQ_PM => { Carp => 0, Test::More => 0.40, }, 'dist' => {COMPRESS => 'gzip -9', SUFFIX => '.gz', DIST_DEFAULT => 'all tardist', }, ); { package MY; sub top_targets { my($self) = @_; return $self->SUPER::top_targets(@_) unless eval { require Pod::Tests; 1 }; my $out = "POD2TEST_EXE = pod2test\n"; $out .= $self->SUPER::top_targets(@_); $out =~ s/^(pure_all\b.*)/$1 testifypods/m; foreach my $pod (keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}) { (my $test = $pod) =~ s/\.(pm|pod)$//; $test =~ s/^lib\W//; $test =~ s/\W/-/; $test = "t/embedded-$test.t"; $pod2test{$pod} = $test; } $out .= <<"END_OF_MAKE"; testifypods : @{[ join " ", values %pod2test ]} \t\$(NOECHO) \$(NOOP) END_OF_MAKE for my $pod (keys %pod2test) { my $test = $pod2test{$pod}; $out .= <<"END_OF_MAKE"; $test : $pod \t\$(NOECHO) \$(ECHO) Testifying $pod to $test \t\$(NOECHO) \$(POD2TEST_EXE) $pod $test END_OF_MAKE } return $out; } sub test_via_harness { my($self, $orig_perl, $tests) = @_; my @perls = ($orig_perl); push @perls, qw(bleadperl perl5.6.1 perl5.005_03 perl5.004_05 perl5.004_04 perl5.004 ) if $ENV{PERL_TEST_ALL}; my $out; foreach my $perl (@perls) { $out .= $self->SUPER::test_via_harness($perl, $tests); } return $out; } } Carp-Assert-0.20/MANIFEST0000644000076500007650000000042710547340463014637 0ustar schwernschwernChanges INSTALL MANIFEST Makefile.PL README lib/Carp/Assert.pm t/10enabled.t t/20disabled.t t/embedded-Carp-Assert.t META.yml Module meta-data (added by MakeMaker) SIGNATURE Public-key signature (added by MakeMaker) Carp-Assert-0.20/META.yml0000664000076500007650000000060510547340463014757 0ustar schwernschwern--- #YAML:1.0 name: Carp-Assert version: 0.20 abstract: ~ license: ~ generated_by: ExtUtils::MakeMaker version 6.31 distribution_type: module requires: Carp: 0 Test::More: 0.4 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 Carp-Assert-0.20/README0000644000076500007650000000477610534645133014377 0ustar schwernschwernNAME Carp::Assert - executable comments SYNOPSIS # Assertions are on. use Carp::Assert; $next_sunrise_time = sunrise(); # Assert that the sun must rise in the next 24 hours. assert(($next_sunrise_time - time) < 24*60*60) if DEBUG; # Assertions are off. no Carp::Assert; $next_pres = divine_next_president(); # Assert that if you predict Dan Quayle will be the next president # your crystal ball might need some polishing. However, since # assertions are off, IT COULD HAPPEN! shouldnt($next_pres, 'Dan Quayle') if DEBUG; DESCRIPTION "We are ready for any unforseen event that may or may not occur." - Dan Quayle Carp::Assert is intended for a purpose like the ANSI C library assert.h. If you're already familiar with assert.h, then you can probably skip this and go straight to the FUNCTIONS section. Assertions are the explict expressions of your assumptions about the reality your program is expected to deal with, and a declaration of those which it is not. They are used to prevent your program from blissfully processing garbage inputs (garbage in, garbage out becomes garbage in, error out) and to tell you when you've produced garbage output. (If I was going to be a cynic about Perl and the user nature, I'd say there are no user inputs but garbage, and Perl produces nothing but...) An assertion is used to prevent the impossible from being asked of your code, or at least tell you when it does. For example: # Take the square root of a number. sub my_sqrt { my($num) = shift; # the square root of a negative number is imaginary. assert($num >= 0); return sqrt $num; } The assertion will warn you if a negative number was handed to your subroutine, a reality the routine has no intention of dealing with. AUTHOR Michael G Schwern WHAT IS THIS? This is Carp::Assert, a perl module. Please see the README that comes with this distribution. HOW DO I INSTALL IT? To install this module, cd to the directory that contains this README file and type the following: perl Makefile.PL make test make install To install this module into a specific directory, do: perl Makefile.PL PREFIX=/name/of/the/directory ...the rest is the same... Please also read the perlmodinstall man page, if available. WHAT MODULES DO I NEED? Carp Carp-Assert-0.20/SIGNATURE0000664000076500007650000000243210547340515014770 0ustar schwernschwernThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 fa207befb96fd78c0d512a50c409ae98fab96759 Changes SHA1 4eedbc4370c3e7678216958e9a3835db6a4b3aab INSTALL SHA1 f3cd54455aab61f263f03774d6a9e69181eeda83 MANIFEST SHA1 7a7b4887b1945d4cad2e723ad57046ad3081e07c META.yml SHA1 9228b9220fc9d07bfb59a0723d6e93b3abe7316f Makefile.PL SHA1 cc4ebb817ca5386d16f96db4b53d67440bc6129e README SHA1 81c95ac909d3b3cf10e93929b242223dfea10f99 lib/Carp/Assert.pm SHA1 c2fac3e9053e10041c3b310a915c3ea1946f6a22 t/10enabled.t SHA1 7f2b5e5a67b472d76585872f8f7bbaffa9b58a3c t/20disabled.t SHA1 b5fead6ab75f727abd8571bfaad9ff21201f92c2 t/embedded-Carp-Assert.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.5 (Darwin) iD8DBQFFncFNWMohlhD1QycRAm86AJ4qDdi94m6dZQZF6S35P8P36U53NgCgy1mi kC8OUhZKrcvRzOjIXWTtQak= =pt/J -----END PGP SIGNATURE----- Carp-Assert-0.20/t/0000755000076500007650000000000010547340463013746 5ustar schwernschwernCarp-Assert-0.20/t/10enabled.t0000644000076500007650000000175210547316610015670 0ustar schwernschwern#!/usr/bin/perl -w # Test with assert on. use strict; use Test::More tests => 8; # Make sure we're shielded against the user possibly having # NDEBUG or PERL_NDEBUG set. Localize the changes because changes # to %ENV persist across processes in VMS. BEGIN { local %ENV = %ENV; delete @ENV{qw(PERL_NDEBUG NDEBUG)}; require Carp::Assert; Carp::Assert->import; } # shouldn't makes its decision at run-time local %ENV = %ENV; delete @ENV{qw(PERL_NDEBUG NDEBUG)}; eval { assert(1==0) if DEBUG; }; like $@, '/^Assertion failed/i'; eval { assert(1==1); }; is $@, ''; eval { assert(Dogs->isa('People'), 'Dogs are people, too!') }; like $@, '/Dogs are people, too!/'; eval { should('this', 'this') }; is $@, ''; eval { should('this', 'that') }; like $@, '/^Assertion \(.*\) failed/i'; eval { shouldnt('this', 'that') }; is $@, ''; eval { shouldnt('up', 'up') }; like $@, '/^Assertion \(.*\) failed/i'; eval { shouldn't('up', 'up') }; like $@, '/^Assertion \(.*\) failed/i'; Carp-Assert-0.20/t/20disabled.t0000644000076500007650000000140110547316610016035 0ustar schwernschwern#!/usr/bin/perl -w # Test with assert off. use strict; use Test::More tests => 25; use Carp::Assert qw(:NDEBUG); my $tests = <<'END_OF_TESTS'; eval { assert(1==0) if DEBUG; }; is $@, ''; eval { assert(1==0); }; is $@, ''; eval { should('this', 'moofer') if DEBUG }; is $@, ''; eval { shouldnt('this', 'this') }; is $@, ''; END_OF_TESTS my @disable_code = ( "use Carp::Assert qw(:NDEBUG);", "no Carp::Assert;", 'BEGIN { $ENV{NDEBUG} = 1; } use Carp::Assert;', 'BEGIN { $ENV{PERL_NDEBUG} = 1; } use Carp::Assert;', 'BEGIN { $ENV{NDEBUG} = 0; $ENV{PERL_NDEBUG} = 1; } use Carp::Assert;' ); for my $code (@disable_code) { local %ENV = %ENV; delete @ENV{qw(PERL_NDEBUG NDEBUG)}; eval $code . "\n" . $tests; is $@, ''; }Carp-Assert-0.20/t/embedded-Carp-Assert.t0000644000076500007650000000741710547340462020016 0ustar schwernschwern#!/usr/local/perl/5.8.8/bin/perl -w use Test::More 'no_plan'; package Catch; sub TIEHANDLE { my($class, $var) = @_; return bless { var => $var }, $class; } sub PRINT { my($self) = shift; ${'main::'.$self->{var}} .= join '', @_; } sub OPEN {} # XXX Hackery in case the user redirects sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want. sub READ {} sub READLINE {} sub GETC {} sub BINMODE {} my $Original_File = 'lib/Carp/Assert.pm'; package main; # pre-5.8.0's warns aren't caught by a tied STDERR. $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDOUT, 'Catch', '_STDOUT_' or die $!; tie *STDERR, 'Catch', '_STDERR_' or die $!; { undef $main::_STDOUT_; undef $main::_STDERR_; #line 115 lib/Carp/Assert.pm BEGIN { local %ENV = %ENV; delete @ENV{qw(PERL_NDEBUG NDEBUG)}; require Carp::Assert; Carp::Assert->import; } local %ENV = %ENV; delete @ENV{qw(PERL_NDEBUG NDEBUG)}; undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 217 lib/Carp/Assert.pm my $life = 'Whimper!'; ok( eval { assert( $life =~ /!$/ ); 1 }, 'life ends with a bang' ); undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 237 lib/Carp/Assert.pm { package Some::Other; no Carp::Assert; ::ok( eval { assert(0) if DEBUG; 1 } ); } undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 248 lib/Carp/Assert.pm ok( eval { assert(1); 1 } ); ok( !eval { assert(0); 1 } ); undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 258 lib/Carp/Assert.pm eval { assert(0) }; like( $@, '/^Assertion failed!/', 'error format' ); like( $@, '/Carp::Assert::assert\(0\) called at/', ' with stack trace' ); undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 273 lib/Carp/Assert.pm eval { assert( Dogs->isa('People'), 'Dogs are people, too!' ); }; like( $@, '/^Assertion \(Dogs are people, too!\) failed!/', 'names' ); undef $main::_STDOUT_; undef $main::_STDERR_; } { undef $main::_STDOUT_; undef $main::_STDERR_; #line 310 lib/Carp/Assert.pm my $foo = 1; my $bar = 2; eval { affirm { $foo == $bar } }; like( $@, '/\$foo == \$bar/' ); undef $main::_STDOUT_; undef $main::_STDERR_; } undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 149 lib/Carp/Assert.pm # Take the square root of a number. sub my_sqrt { my($num) = shift; # the square root of a negative number is imaginary. assert($num >= 0); return sqrt $num; } ; } }; is($@, '', "example from line 149"); { undef $main::_STDOUT_; undef $main::_STDERR_; #line 149 lib/Carp/Assert.pm # Take the square root of a number. sub my_sqrt { my($num) = shift; # the square root of a negative number is imaginary. assert($num >= 0); return sqrt $num; } is( my_sqrt(4), 2, 'my_sqrt example with good input' ); ok( !eval{ my_sqrt(-1); 1 }, ' and pukes on bad' ); undef $main::_STDOUT_; undef $main::_STDERR_; } undef $main::_STDOUT_; undef $main::_STDERR_; undef $main::_STDOUT_; undef $main::_STDERR_; eval q{ my $example = sub { local $^W = 0; #line 300 lib/Carp/Assert.pm affirm { my $customer = Customer->new($customerid); my @cards = $customer->credit_cards; grep { $_->is_active } @cards; } "Our customer has an active credit card"; ; } }; is($@, '', "example from line 300"); undef $main::_STDOUT_; undef $main::_STDERR_;