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