File Coverage

blib/lib/Carp/Assert.pm
Criterion Covered Total %
statement n/a
branch n/a
condition n/a
subroutine n/a
pod n/a
total n/a


line stmt bran cond sub pod time code
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 };<