File Coverage

blib/lib/Test/Tolerant.pm
Criterion Covered Total %
statement 34 34 100.0
branch 9 14 64.2
condition 6 9 66.6
subroutine 8 8 100.0
pod 1 1 100.0
total 58 66 87.8


line stmt bran cond sub pod time code
1 1     1   50778 use strict;
  1         9  
  1         21  
2 1     1   4 use warnings;
  1         1  
  1         31  
3             package Test::Tolerant 1.709;
4             # ABSTRACT: test routines for testing numbers against tolerances
5              
6             #pod =head1 SYNOPSIS
7             #pod
8             #pod use Test::More;
9             #pod use Test::Tolerant;
10             #pod
11             #pod my $total = rand(6) + rand(6) + rand(6);
12             #pod is_tol(10, [ qw( 3 to 18 ) ], "got an acceptable result from random dice");
13             #pod
14             #pod done_testing;
15             #pod
16             #pod =head1 FUNCTIONS
17             #pod
18             #pod =head2 is_tol
19             #pod
20             #pod is_tol($have, $want_spec, $comment);
21             #pod
22             #pod C is the only routine provided by Test::Tolerant, and is exported by
23             #pod default. It beahves like C> from Test::More, asserting
24             #pod that two values must be equal, but it will always use numeric equality, and the
25             #pod second argument is not always used as the right hand side of comparison
26             #pod directly, but it used to produce a L to compare to.
27             #pod
28             #pod C<$have_spec> can be:
29             #pod
30             #pod * a Number::Tolerant object
31             #pod * an arrayref of args to Number::Tolerant->new
32             #pod * a string to be passed to Number::Tolerant->from_string
33             #pod * a literal number falls under this group
34             #pod
35             #pod If the value is outside of spec, you'll get a diagnostic message something like
36             #pod this:
37             #pod
38             #pod given value is outside acceptable tolerances
39             #pod have: 3
40             #pod want: 5 < x
41             #pod
42             #pod =cut
43              
44 1     1   4 use Carp ();
  1         1  
  1         13  
45 1     1   319 use Number::Tolerant qw(tolerance);
  1         2  
  1         3  
46 1     1   207 use Scalar::Util qw(blessed looks_like_number reftype);
  1         1  
  1         36  
47 1     1   4 use Test::Builder;
  1         1  
  1         26  
48              
49 1         4 use Sub::Exporter -setup => {
50             exports => [ qw(is_tol) ],
51             groups => [
52             default => [ qw(is_tol) ],
53             ],
54 1     1   3 };
  1         1  
55              
56             my $Test = Test::Builder->new;
57              
58             sub is_tol {
59 4     4 1 4839 my ($have, $spec, $desc) = @_;
60              
61 4         5 my $want;
62              
63 4 100 66     35 if (blessed $spec and $spec->isa('Number::Tolerant')) {
    100 66        
    50 66        
64 1         2 $want = $spec;
65             } elsif (ref $spec and not(blessed $spec) and reftype $spec eq 'ARRAY') {
66 1         4 $want = tolerance(@$spec);
67             } elsif (! ref $spec) {
68 2         8 $want = Number::Tolerant->from_string($spec);
69             }
70              
71 4 50       8 Carp::croak("couldn't build a tolerance from $spec") unless defined $want;
72              
73 4 100       61 return 1 if $Test->ok($have == $want, $desc);
74              
75             # XXX: make this work -- rjbs, 2010-11-29
76 3         795 my $cmp = $have <=> $want;
77 3 0       5 my $why = $cmp == -1 ? "is below"
    50          
78             : $cmp == 1 ? "is above"
79             : "is outside";
80              
81 3         16 $Test->diag("given value $why acceptable tolerances");
82 3         332 $Test->diag(sprintf "%8s: %s\n%8s: %s\n", have => $have, want => $want);
83              
84 3         285 return 0;
85             }
86              
87             1;
88              
89             __END__