home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Carp / Assert.pm next >
Encoding:
Perl POD Document  |  2008-02-20  |  15.4 KB  |  553 lines

  1. package Carp::Assert;
  2.  
  3. require 5.004;
  4.  
  5. use strict qw(subs vars);
  6. use Exporter;
  7.  
  8. use vars qw(@ISA $VERSION %EXPORT_TAGS);
  9.  
  10. BEGIN {
  11.     $VERSION = '0.20';
  12.  
  13.     @ISA = qw(Exporter);
  14.  
  15.     %EXPORT_TAGS = (
  16.                     NDEBUG => [qw(assert affirm should shouldnt DEBUG)],
  17.                    );
  18.     $EXPORT_TAGS{DEBUG} = $EXPORT_TAGS{NDEBUG};
  19.     Exporter::export_tags(qw(NDEBUG DEBUG));
  20. }
  21.  
  22. # constant.pm, alas, adds too much load time (yes, I benchmarked it)
  23. sub REAL_DEBUG  ()  { 1 }       # CONSTANT
  24. sub NDEBUG      ()  { 0 }       # CONSTANT
  25.  
  26. # Export the proper DEBUG flag according to if :NDEBUG is set.
  27. # Also export noop versions of our routines if NDEBUG
  28. sub noop { undef }
  29. sub noop_affirm (&;$) { undef };
  30.  
  31. sub import {
  32.     my $env_ndebug = exists $ENV{PERL_NDEBUG} ? $ENV{PERL_NDEBUG}
  33.                                               : $ENV{'NDEBUG'};
  34.     if( grep(/^:NDEBUG$/, @_) or $env_ndebug ) {
  35.         my $caller = caller;
  36.         foreach my $func (grep !/^DEBUG$/, @{$EXPORT_TAGS{'NDEBUG'}}) {
  37.             if( $func eq 'affirm' ) {
  38.                 *{$caller.'::'.$func} = \&noop_affirm;
  39.             } else {
  40.                 *{$caller.'::'.$func} = \&noop;
  41.             }
  42.         }
  43.         *{$caller.'::DEBUG'} = \&NDEBUG;
  44.     }
  45.     else {
  46.         *DEBUG = *REAL_DEBUG;
  47.         Carp::Assert->_export_to_level(1, @_);
  48.     }
  49. }
  50.  
  51.  
  52. # 5.004's Exporter doesn't have export_to_level.
  53. sub _export_to_level
  54. {
  55.       my $pkg = shift;
  56.       my $level = shift;
  57.       (undef) = shift;                  # XXX redundant arg
  58.       my $callpkg = caller($level);
  59.       $pkg->export($callpkg, @_);
  60. }
  61.  
  62.  
  63. sub unimport {
  64.     *DEBUG = *NDEBUG;
  65.     push @_, ':NDEBUG';
  66.     goto &import;
  67. }
  68.  
  69.  
  70. # Can't call confess() here or the stack trace will be wrong.
  71. sub _fail_msg {
  72.     my($name) = shift;
  73.     my $msg = 'Assertion';
  74.     $msg   .= " ($name)" if defined $name;
  75.     $msg   .= " failed!\n";
  76.     return $msg;
  77. }
  78.  
  79.  
  80. =head1 NAME
  81.  
  82. Carp::Assert - executable comments
  83.  
  84. =head1 SYNOPSIS
  85.  
  86.     # Assertions are on.
  87.     use Carp::Assert;
  88.  
  89.     $next_sunrise_time = sunrise();
  90.  
  91.     # Assert that the sun must rise in the next 24 hours.
  92.     assert(($next_sunrise_time - time) < 24*60*60) if DEBUG;
  93.  
  94.     # Assert that your customer's primary credit card is active
  95.     affirm {
  96.         my @cards = @{$customer->credit_cards};
  97.         $cards[0]->is_active;
  98.     };
  99.  
  100.  
  101.     # Assertions are off.
  102.     no Carp::Assert;
  103.  
  104.     $next_pres = divine_next_president();
  105.  
  106.     # Assert that if you predict Dan Quayle will be the next president
  107.     # your crystal ball might need some polishing.  However, since
  108.     # assertions are off, IT COULD HAPPEN!
  109.     shouldnt($next_pres, 'Dan Quayle') if DEBUG;
  110.  
  111.  
  112. =head1 DESCRIPTION
  113.  
  114. =begin testing
  115.  
  116. BEGIN {
  117.     local %ENV = %ENV;
  118.     delete @ENV{qw(PERL_NDEBUG NDEBUG)};
  119.     require Carp::Assert;
  120.     Carp::Assert->import;
  121. }
  122.  
  123. local %ENV = %ENV;
  124. delete @ENV{qw(PERL_NDEBUG NDEBUG)};
  125.  
  126. =end testing
  127.  
  128.     "We are ready for any unforseen event that may or may not 
  129.     occur."
  130.         - Dan Quayle
  131.  
  132. Carp::Assert is intended for a purpose like the ANSI C library
  133. assert.h.  If you're already familiar with assert.h, then you can
  134. probably skip this and go straight to the FUNCTIONS section.
  135.  
  136. Assertions are the explict expressions of your assumptions about the
  137. reality your program is expected to deal with, and a declaration of
  138. those which it is not.  They are used to prevent your program from
  139. blissfully processing garbage inputs (garbage in, garbage out becomes
  140. garbage in, error out) and to tell you when you've produced garbage
  141. output.  (If I was going to be a cynic about Perl and the user nature,
  142. I'd say there are no user inputs but garbage, and Perl produces
  143. nothing but...)
  144.  
  145. An assertion is used to prevent the impossible from being asked of
  146. your code, or at least tell you when it does.  For example:
  147.  
  148. =for example begin
  149.  
  150.     # Take the square root of a number.
  151.     sub my_sqrt {
  152.         my($num) = shift;
  153.  
  154.         # the square root of a negative number is imaginary.
  155.         assert($num >= 0);
  156.  
  157.         return sqrt $num;
  158.     }
  159.  
  160. =for example end
  161.  
  162. =for example_testing
  163. is( my_sqrt(4),  2,            'my_sqrt example with good input' );
  164. ok( !eval{ my_sqrt(-1); 1 },   '  and pukes on bad' );
  165.  
  166. The assertion will warn you if a negative number was handed to your
  167. subroutine, a reality the routine has no intention of dealing with.
  168.  
  169. An assertion should also be used as something of a reality check, to
  170. make sure what your code just did really did happen:
  171.  
  172.     open(FILE, $filename) || die $!;
  173.     @stuff = <FILE>;
  174.     @stuff = do_something(@stuff);
  175.  
  176.     # I should have some stuff.
  177.     assert(@stuff > 0);
  178.  
  179. The assertion makes sure you have some @stuff at the end.  Maybe the
  180. file was empty, maybe do_something() returned an empty list... either
  181. way, the assert() will give you a clue as to where the problem lies,
  182. rather than 50 lines down at when you wonder why your program isn't
  183. printing anything.
  184.  
  185. Since assertions are designed for debugging and will remove themelves
  186. from production code, your assertions should be carefully crafted so
  187. as to not have any side-effects, change any variables, or otherwise
  188. have any effect on your program.  Here is an example of a bad
  189. assertation:
  190.  
  191.     assert($error = 1 if $king ne 'Henry');  # Bad!
  192.  
  193. It sets an error flag which may then be used somewhere else in your
  194. program. When you shut off your assertions with the $DEBUG flag,
  195. $error will no longer be set.
  196.  
  197. Here's another example of B<bad> use:
  198.  
  199.     assert($next_pres ne 'Dan Quayle' or goto Canada);  # Bad!
  200.  
  201. This assertion has the side effect of moving to Canada should it fail.
  202. This is a very bad assertion since error handling should not be
  203. placed in an assertion, nor should it have side-effects.
  204.  
  205. In short, an assertion is an executable comment.  For instance, instead
  206. of writing this
  207.  
  208.     # $life ends with a '!'
  209.     $life = begin_life();
  210.  
  211. you'd replace the comment with an assertion which B<enforces> the comment.
  212.  
  213.     $life = begin_life();
  214.     assert( $life =~ /!$/ );
  215.  
  216. =for testing
  217. my $life = 'Whimper!';
  218. ok( eval { assert( $life =~ /!$/ ); 1 },   'life ends with a bang' );
  219.  
  220.  
  221. =head1 FUNCTIONS
  222.  
  223. =over 4
  224.  
  225. =item B<assert>
  226.  
  227.     assert(EXPR) if DEBUG;
  228.     assert(EXPR, $name) if DEBUG;
  229.  
  230. assert's functionality is effected by compile time value of the DEBUG
  231. constant, controlled by saying C<use Carp::Assert> or C<no
  232. Carp::Assert>.  In the former case, assert will function as below.
  233. Otherwise, the assert function will compile itself out of the program.
  234. See L<Debugging vs Production> for details.
  235.  
  236. =for testing
  237. {
  238.   package Some::Other;
  239.   no Carp::Assert;
  240.   ::ok( eval { assert(0) if DEBUG; 1 } );
  241. }
  242.  
  243. Give assert an expression, assert will Carp::confess() if that
  244. expression is false, otherwise it does nothing.  (DO NOT use the
  245. return value of assert for anything, I mean it... really!).
  246.  
  247. =for testing
  248. ok( eval { assert(1); 1 } );
  249. ok( !eval { assert(0); 1 } );
  250.  
  251. The error from assert will look something like this:
  252.  
  253.     Assertion failed!
  254.             Carp::Assert::assert(0) called at prog line 23
  255.             main::foo called at prog line 50
  256.  
  257. =for testing
  258. eval { assert(0) };
  259. like( $@, '/^Assertion failed!/',       'error format' );
  260. like( $@, '/Carp::Assert::assert\(0\) called at/',      '  with stack trace' );
  261.  
  262. Indicating that in the file "prog" an assert failed inside the
  263. function main::foo() on line 23 and that foo() was in turn called from
  264. line 50 in the same file.
  265.  
  266. If given a $name, assert() will incorporate this into your error message,
  267. giving users something of a better idea what's going on.
  268.  
  269.     assert( Dogs->isa('People'), 'Dogs are people, too!' ) if DEBUG;
  270.     # Result - "Assertion (Dogs are people, too!) failed!"
  271.  
  272. =for testing
  273. eval { assert( Dogs->isa('People'), 'Dogs are people, too!' ); };
  274. like( $@, '/^Assertion \(Dogs are people, too!\) failed!/', 'names' );
  275.  
  276. =cut
  277.  
  278. sub assert ($;$) {
  279.     unless($_[0]) {
  280.         require Carp;
  281.         Carp::confess( _fail_msg($_[1]) );
  282.     }
  283.     return undef;
  284. }
  285.  
  286.  
  287. =item B<affirm>
  288.  
  289.     affirm BLOCK if DEBUG;
  290.     affirm BLOCK $name if DEBUG;
  291.  
  292. Very similar to assert(), but instead of taking just a simple
  293. expression it takes an entire block of code and evaluates it to make
  294. sure its true.  This can allow more complicated assertions than
  295. assert() can without letting the debugging code leak out into
  296. production and without having to smash together several
  297. statements into one.
  298.  
  299. =for example begin
  300.  
  301.     affirm {
  302.         my $customer = Customer->new($customerid);
  303.         my @cards = $customer->credit_cards;
  304.         grep { $_->is_active } @cards;
  305.     } "Our customer has an active credit card";
  306.  
  307. =for example end
  308.  
  309. =for testing
  310. my $foo = 1;  my $bar = 2;
  311. eval { affirm { $foo == $bar } };
  312. like( $@, '/\$foo == \$bar/' );
  313.  
  314.  
  315. affirm() also has the nice side effect that if you forgot the C<if DEBUG>
  316. suffix its arguments will not be evaluated at all.  This can be nice
  317. if you stick affirm()s with expensive checks into hot loops and other
  318. time-sensitive parts of your program.
  319.  
  320. If the $name is left off and your Perl version is 5.6 or higher the
  321. affirm() diagnostics will include the code begin affirmed.
  322.  
  323. =cut
  324.  
  325. sub affirm (&;$) {
  326.     unless( eval { &{$_[0]}; } ) {
  327.         my $name = $_[1];
  328.  
  329.         if( !defined $name ) {
  330.             eval {
  331.                 require B::Deparse;
  332.                 $name = B::Deparse->new->coderef2text($_[0]);
  333.             };
  334.             $name = 
  335.               'code display non-functional on this version of Perl, sorry'
  336.                 if $@;
  337.         }
  338.  
  339.         require Carp;
  340.         Carp::confess( _fail_msg($name) );
  341.     }
  342.     return undef;
  343. }
  344.  
  345. =item B<should>
  346.  
  347. =item B<shouldnt>
  348.  
  349.     should  ($this, $shouldbe)   if DEBUG;
  350.     shouldnt($this, $shouldntbe) if DEBUG;
  351.  
  352. Similar to assert(), it is specially for simple "this should be that"
  353. or "this should be anything but that" style of assertions.
  354.  
  355. Due to Perl's lack of a good macro system, assert() can only report
  356. where something failed, but it can't report I<what> failed or I<how>.
  357. should() and shouldnt() can produce more informative error messages:
  358.  
  359.     Assertion ('this' should be 'that'!) failed!
  360.             Carp::Assert::should('this', 'that') called at moof line 29
  361.             main::foo() called at moof line 58
  362.  
  363. So this:
  364.  
  365.     should($this, $that) if DEBUG;
  366.  
  367. is similar to this:
  368.  
  369.     assert($this eq $that) if DEBUG;
  370.  
  371. except for the better error message.
  372.  
  373. Currently, should() and shouldnt() can only do simple eq and ne tests
  374. (respectively).  Future versions may allow regexes.
  375.  
  376. =cut
  377.  
  378. sub should ($$) {
  379.     unless($_[0] eq $_[1]) {
  380.         require Carp;
  381.         &Carp::confess( _fail_msg("'$_[0]' should be '$_[1]'!") );
  382.     }
  383.     return undef;
  384. }
  385.  
  386. sub shouldnt ($$) {
  387.     unless($_[0] ne $_[1]) {
  388.         require Carp;
  389.         &Carp::confess( _fail_msg("'$_[0]' shouldn't be that!") );
  390.     }
  391.     return undef;
  392. }
  393.  
  394. # Sorry, I couldn't resist.
  395. sub shouldn't ($$) {     # emacs cperl-mode madness #' sub {
  396.     my $env_ndebug = exists $ENV{PERL_NDEBUG} ? $ENV{PERL_NDEBUG}
  397.                                               : $ENV{'NDEBUG'};
  398.     if( $env_ndebug ) {
  399.         return undef;
  400.     }
  401.     else {
  402.         shouldnt($_[0], $_[1]);
  403.     }
  404. }
  405.  
  406. =back
  407.  
  408. =head1 Debugging vs Production
  409.  
  410. Because assertions are extra code and because it is sometimes necessary to
  411. place them in 'hot' portions of your code where speed is paramount,
  412. Carp::Assert provides the option to remove its assert() calls from your
  413. program.
  414.  
  415. So, we provide a way to force Perl to inline the switched off assert()
  416. routine, thereby removing almost all performance impact on your production
  417. code.
  418.  
  419.     no Carp::Assert;  # assertions are off.
  420.     assert(1==1) if DEBUG;
  421.  
  422. DEBUG is a constant set to 0.  Adding the 'if DEBUG' condition on your
  423. assert() call gives perl the cue to go ahead and remove assert() call from
  424. your program entirely, since the if conditional will always be false.
  425.  
  426.     # With C<no Carp::Assert> the assert() has no impact.
  427.     for (1..100) {
  428.         assert( do_some_really_time_consuming_check ) if DEBUG;
  429.     }
  430.  
  431. If C<if DEBUG> gets too annoying, you can always use affirm().
  432.  
  433.     # Once again, affirm() has (almost) no impact with C<no Carp::Assert>
  434.     for (1..100) {
  435.         affirm { do_some_really_time_consuming_check };
  436.     }
  437.  
  438. Another way to switch off all asserts, system wide, is to define the
  439. NDEBUG or the PERL_NDEBUG environment variable.
  440.  
  441. You can safely leave out the "if DEBUG" part, but then your assert()
  442. function will always execute (and its arguments evaluated and time
  443. spent).  To get around this, use affirm().  You still have the
  444. overhead of calling a function but at least its arguments will not be
  445. evaluated.
  446.  
  447.  
  448. =head1 Differences from ANSI C
  449.  
  450. assert() is intended to act like the function from ANSI C fame. 
  451. Unfortunately, due to Perl's lack of macros or strong inlining, it's not
  452. nearly as unobtrusive.
  453.  
  454. Well, the obvious one is the "if DEBUG" part.  This is cleanest way I could
  455. think of to cause each assert() call and its arguments to be removed from
  456. the program at compile-time, like the ANSI C macro does.
  457.  
  458. Also, this version of assert does not report the statement which
  459. failed, just the line number and call frame via Carp::confess.  You
  460. can't do C<assert('$a == $b')> because $a and $b will probably be
  461. lexical, and thus unavailable to assert().  But with Perl, unlike C,
  462. you always have the source to look through, so the need isn't as
  463. great.
  464.  
  465.  
  466. =head1 EFFICIENCY
  467.  
  468. With C<no Carp::Assert> (or NDEBUG) and using the C<if DEBUG> suffixes
  469. on all your assertions, Carp::Assert has almost no impact on your
  470. production code.  I say almost because it does still add some load-time
  471. to your code (I've tried to reduce this as much as possible).
  472.  
  473. If you forget the C<if DEBUG> on an C<assert()>, C<should()> or
  474. C<shouldnt()>, its arguments are still evaluated and thus will impact
  475. your code.  You'll also have the extra overhead of calling a
  476. subroutine (even if that subroutine does nothing).
  477.  
  478. Forgetting the C<if DEBUG> on an C<affirm()> is not so bad.  While you
  479. still have the overhead of calling a subroutine (one that does
  480. nothing) it will B<not> evaluate its code block and that can save
  481. alot.
  482.  
  483. Try to remember the B<if DEBUG>.
  484.  
  485.  
  486. =head1 ENVIRONMENT
  487.  
  488. =over 4
  489.  
  490. =item NDEBUG
  491.  
  492. Defining NDEBUG switches off all assertions.  It has the same effect
  493. as changing "use Carp::Assert" to "no Carp::Assert" but it effects all
  494. code.
  495.  
  496. =item PERL_NDEBUG
  497.  
  498. Same as NDEBUG and will override it.  Its provided to give you
  499. something which won't conflict with any C programs you might be
  500. working on at the same time.
  501.  
  502. =back
  503.  
  504.  
  505. =head1 BUGS, CAVETS and other MUSINGS
  506.  
  507. =head2 Conflicts with C<POSIX.pm>
  508.  
  509. 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:
  510.  
  511.     use POSIX ();
  512.     use Carp::Assert;
  513.  
  514. Since C<POSIX> exports way too much, you should be using it like that anyway.
  515.  
  516. =head2 C<affirm> and C<$^S>
  517.  
  518. affirm() mucks with the expression's caller and it is run in an eval
  519. so anything that checks $^S will be wrong.
  520.  
  521. =head2 C<shouldn't>
  522.  
  523. Yes, there is a C<shouldn't> routine.  It mostly works, but you B<must>
  524. put the C<if DEBUG> after it.
  525.  
  526. =head2 missing C<if DEBUG>
  527.  
  528. It would be nice if we could warn about missing C<if DEBUG>.
  529.  
  530.  
  531. =head1 SEE ALSO
  532.  
  533. 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.
  534.  
  535.  
  536. =head1 COPYRIGHT
  537.  
  538. Copyright 2001-2007 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
  539.  
  540. This program is free software; you can redistribute it and/or 
  541. modify it under the same terms as Perl itself.
  542.  
  543. See F<http://dev.perl.org/licenses/>
  544.  
  545.  
  546. =head1 AUTHOR
  547.  
  548. Michael G Schwern <schwern@pobox.com>
  549.  
  550. =cut
  551.  
  552. return q|You don't just EAT the largest turnip in the world!|;
  553.