File Coverage

blib/lib/Assert/Refute/T/Scalar.pm
Criterion Covered Total %
statement 22 22 100.0
branch 6 6 100.0
condition 1 2 50.0
subroutine 6 6 100.0
pod n/a
total 35 36 97.2


line stmt bran cond sub pod time code
1             package Assert::Refute::T::Scalar;
2              
3 1     1   485 use strict;
  1         2  
  1         28  
4 1     1   5 use warnings;
  1         1  
  1         39  
5             our $VERSION = '0.1501';
6              
7             =head1 NAME
8              
9             Assert::Refute::T::Scalar - Assertions about scalars for Assert::Refute suite.
10              
11             =head1 SYNOPSIS
12              
13             Currently only one check exists in this package, C.
14              
15             use Test::More;
16             use Assert::Refute::T::Scalar;
17              
18             maybe_is $foo, undef, 'Only passes if $foo is undefined';
19             maybe_is $bar, 42, 'Only if undef or exact match';
20             maybe_is $baz, qr/.../, 'Only if undef or matches regex';
21             maybe_is $quux, sub { ok $_ }, 'Only if all refutations hold for $_';
22              
23             done_testing;
24              
25             =head1 EXPORTS
26              
27             All of the below functions are exported by default:
28              
29             =cut
30              
31 1     1   6 use Carp;
  1         1  
  1         61  
32 1     1   7 use parent qw(Exporter);
  1         2  
  1         5  
33              
34 1     1   47 use Assert::Refute::Build;
  1         2  
  1         174  
35              
36             =head2 maybe_is $value, $condition, "message"
37              
38             Pass if value is C, apply condition otherwise.
39              
40             Condition can be:
41              
42             =over
43              
44             =item * C - only undefined value fits;
45              
46             =item * a plain scalar - an exact match expected (think C);
47              
48             =item * a regular expression - match it (think C);
49              
50             =item * anything else - assume it's subcontract.
51             The value in question will be passed as I an argument and C<$_>.
52              
53             =back
54              
55             B<[EXPERIMENTAL]> This function may be removed for good
56             if it turns out too complex (I).
57              
58             =cut
59              
60             build_refute maybe_is => sub {
61 14     14   32 my ($self, $var, $cond, $message) = @_;
62              
63 14 100       32 return $self->refute(0, $message) unless defined $var;
64 11 100       28 return $self->is( $var, $cond ) unless ref $cond;
65 7 100       19 return $self->like( $var, $cond ) if ref $cond eq 'Regexp';
66              
67 5   50     24 $message ||= "maybe_is";
68 5         8 local $_ = $var;
69 5         13 return $self->subcontract( $message => $cond, $_ );
70             }, manual => 1, args => 2, export => 1;
71              
72             =head1 LICENSE AND COPYRIGHT
73              
74             This module is part of L suite.
75              
76             Copyright 2017-2018 Konstantin S. Uvarin. C<< >>
77              
78             This program is free software; you can redistribute it and/or modify it
79             under the terms of the the Artistic License (2.0). You may obtain a
80             copy of the full license at:
81              
82             L
83              
84             =cut
85              
86             1;