r10113 - in /branches/upstream/libcarp-assert-perl: ./ current/ current/lib/ current/lib/Carp/ current/t/
vdanjean at users.alioth.debian.org
vdanjean at users.alioth.debian.org
Sat Dec 1 11:51:27 UTC 2007
Author: vdanjean
Date: Sat Dec 1 11:51:27 2007
New Revision: 10113
URL: http://svn.debian.org/wsvn/?sc=1&rev=10113
Log:
[svn-inject] Installing original source of libcarp-assert-perl
Added:
branches/upstream/libcarp-assert-perl/
branches/upstream/libcarp-assert-perl/current/
branches/upstream/libcarp-assert-perl/current/Changes
branches/upstream/libcarp-assert-perl/current/INSTALL
branches/upstream/libcarp-assert-perl/current/MANIFEST
branches/upstream/libcarp-assert-perl/current/META.yml
branches/upstream/libcarp-assert-perl/current/Makefile.PL
branches/upstream/libcarp-assert-perl/current/README
branches/upstream/libcarp-assert-perl/current/SIGNATURE
branches/upstream/libcarp-assert-perl/current/lib/
branches/upstream/libcarp-assert-perl/current/lib/Carp/
branches/upstream/libcarp-assert-perl/current/lib/Carp/Assert.pm
branches/upstream/libcarp-assert-perl/current/t/
branches/upstream/libcarp-assert-perl/current/t/10enabled.t
branches/upstream/libcarp-assert-perl/current/t/20disabled.t
branches/upstream/libcarp-assert-perl/current/t/embedded-Carp-Assert.t
Added: branches/upstream/libcarp-assert-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/Changes?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/Changes (added)
+++ branches/upstream/libcarp-assert-perl/current/Changes Sat Dec 1 11:51:27 2007
@@ -1,0 +1,75 @@
+0.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
+
Added: branches/upstream/libcarp-assert-perl/current/INSTALL
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/INSTALL?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/INSTALL (added)
+++ branches/upstream/libcarp-assert-perl/current/INSTALL Sat Dec 1 11:51:27 2007
@@ -1,0 +1,24 @@
+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
+ 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
Added: branches/upstream/libcarp-assert-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/MANIFEST?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/MANIFEST (added)
+++ branches/upstream/libcarp-assert-perl/current/MANIFEST Sat Dec 1 11:51:27 2007
@@ -1,0 +1,11 @@
+Changes
+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)
Added: branches/upstream/libcarp-assert-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/META.yml?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/META.yml (added)
+++ branches/upstream/libcarp-assert-perl/current/META.yml Sat Dec 1 11:51:27 2007
@@ -1,0 +1,13 @@
+--- #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
Added: branches/upstream/libcarp-assert-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/Makefile.PL?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/Makefile.PL (added)
+++ branches/upstream/libcarp-assert-perl/current/Makefile.PL Sat Dec 1 11:51:27 2007
@@ -1,0 +1,84 @@
+use 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;
+ }
+}
Added: branches/upstream/libcarp-assert-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/README?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/README (added)
+++ branches/upstream/libcarp-assert-perl/current/README Sat Dec 1 11:51:27 2007
@@ -1,0 +1,82 @@
+NAME
+ 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 <schwern at pobox.com>
+
+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
Added: branches/upstream/libcarp-assert-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/SIGNATURE?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/SIGNATURE (added)
+++ branches/upstream/libcarp-assert-perl/current/SIGNATURE Sat Dec 1 11:51:27 2007
@@ -1,0 +1,33 @@
+This 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-----
Added: branches/upstream/libcarp-assert-perl/current/lib/Carp/Assert.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/lib/Carp/Assert.pm?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/lib/Carp/Assert.pm (added)
+++ branches/upstream/libcarp-assert-perl/current/lib/Carp/Assert.pm Sat Dec 1 11:51:27 2007
@@ -1,0 +1,552 @@
+package 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 = <FILE>;
+ @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<bad> 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<enforces> 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>
+
+ 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<use Carp::Assert> or C<no
+Carp::Assert>. In the former case, assert will function as below.
+Otherwise, the assert function will compile itself out of the program.
+See L<Debugging vs Production> 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>
+
+ 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<if DEBUG>
+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<should>
+
+=item B<shouldnt>
+
+ 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<what> failed or I<how>.
+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<no Carp::Assert> the assert() has no impact.
+ for (1..100) {
+ assert( do_some_really_time_consuming_check ) if DEBUG;
+ }
+
+If C<if DEBUG> gets too annoying, you can always use affirm().
+
+ # Once again, affirm() has (almost) no impact with C<no Carp::Assert>
+ 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<assert('$a == $b')> 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<no Carp::Assert> (or NDEBUG) and using the C<if DEBUG> 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<if DEBUG> on an C<assert()>, C<should()> or
+C<shouldnt()>, 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<if DEBUG> on an C<affirm()> is not so bad. While you
+still have the overhead of calling a subroutine (one that does
+nothing) it will B<not> evaluate its code block and that can save
+alot.
+
+Try to remember the B<if DEBUG>.
+
+
+=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<POSIX.pm>
+
+The C<POSIX> module exports an C<assert> routine which will conflict with C<Carp::Assert> if both are used in the same namespace. If you are using both together, prevent C<POSIX> from exporting like so:
+
+ use POSIX ();
+ use Carp::Assert;
+
+Since C<POSIX> exports way too much, you should be using it like that anyway.
+
+=head2 C<affirm> 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<shouldn't>
+
+Yes, there is a C<shouldn't> routine. It mostly works, but you B<must>
+put the C<if DEBUG> after it.
+
+=head2 missing C<if DEBUG>
+
+It would be nice if we could warn about missing C<if DEBUG>.
+
+
+=head1 SEE ALSO
+
+L<assertions> is a new module available in 5.9.0 which provides assertions which can be enabled/disabled at compile time for real, no C<if DEBUG> necessary.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001-2007 by Michael G Schwern E<lt>schwern at pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://dev.perl.org/licenses/>
+
+
+=head1 AUTHOR
+
+Michael G Schwern <schwern at pobox.com>
+
+=cut
+
+return q|You don't just EAT the largest turnip in the world!|;
Added: branches/upstream/libcarp-assert-perl/current/t/10enabled.t
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/t/10enabled.t?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/t/10enabled.t (added)
+++ branches/upstream/libcarp-assert-perl/current/t/10enabled.t Sat Dec 1 11:51:27 2007
@@ -1,0 +1,52 @@
+#!/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';
Added: branches/upstream/libcarp-assert-perl/current/t/20disabled.t
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/t/20disabled.t?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/t/20disabled.t (added)
+++ branches/upstream/libcarp-assert-perl/current/t/20disabled.t Sat Dec 1 11:51:27 2007
@@ -1,0 +1,44 @@
+#!/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 $@, '';
+}
Added: branches/upstream/libcarp-assert-perl/current/t/embedded-Carp-Assert.t
URL: http://svn.debian.org/wsvn/branches/upstream/libcarp-assert-perl/current/t/embedded-Carp-Assert.t?rev=10113&op=file
==============================================================================
--- branches/upstream/libcarp-assert-perl/current/t/embedded-Carp-Assert.t (added)
+++ branches/upstream/libcarp-assert-perl/current/t/embedded-Carp-Assert.t Sat Dec 1 11:51:27 2007
@@ -1,0 +1,202 @@
+#!/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_;
+
More information about the Pkg-perl-cvs-commits
mailing list