File Coverage

blib/lib/Test2/Compare/Type.pm
Criterion Covered Total %
statement 57 57 100.0
branch 13 14 92.8
condition 11 12 91.6
subroutine 15 15 100.0
pod 3 4 75.0
total 99 102 97.0


line stmt bran cond sub pod time code
1             package Test2::Compare::Type;
2              
3 2     2   12 use strict;
  2         3  
  2         68  
4 2     2   10 use warnings;
  2         3  
  2         93  
5              
6 2     2   10 use base 'Test2::Compare::Base';
  2         3  
  2         327  
7              
8             our $VERSION = '1.0.1';
9              
10 2     2   14 use Test2::Compare qw(compare strict_convert);
  2         5  
  2         112  
11 2     2   11 use Test2::Compare::Negatable;
  2         4  
  2         22  
12 2     2   410 use Test2::Tools::Type ();
  2         5  
  2         42  
13 2     2   8 use Test2::Util::HashBase qw(type);
  2         4  
  2         8  
14 2     2   707 use Scalar::Type qw(bool_supported);
  2         5  
  2         12  
15 2     2   19 use Scalar::Util qw(reftype blessed);
  2         5  
  2         139  
16              
17 2     2   18 use Carp qw(croak);
  2         5  
  2         975  
18              
19             sub init {
20 28     28 0 428 my $self = shift;
21              
22 28 100       51 croak "'type' requires at least one argument" unless(@{$self->{+TYPE}});
  28         419  
23              
24 27         50 foreach my $type (@{$self->{+TYPE}}) {
  27         102  
25 51 100 66     681 croak "'$type' is not a valid argument, must either be Test2::Tools::Type checkers or Test2::Compare::* object"
      100        
26             unless(
27             Test2::Tools::Type->can("is_$type") ||
28             (blessed($type) && $type->isa('Test2::Compare::Base'))
29             );
30             }
31              
32 25         97 $self->SUPER::init();
33             }
34              
35             sub name {
36             join(
37             " and ",
38             map {
39 26 100       106 blessed($_) ? blessed($_) : $_
40 12     12 1 268 } @{shift->{+TYPE}}
  12         36  
41             );
42             }
43              
44 12 100   12 1 2617 sub operator { join(' ', 'is', (shift->{+NEGATE} ? 'not' : ()), 'of type') }
45              
46             sub verify {
47 25     25 1 6001 my $self = shift;
48 25         101 my %params = @_;
49 25         71 my ($got, $exists) = @params{qw/got exists/};
50              
51 25 50       71 return 0 unless $exists;
52              
53 25         89 my $result = 1;
54 25         40 foreach my $type (@{$self->{+TYPE}}) {
  25         70  
55 48 100       385 if(Test2::Tools::Type->can("is_$type")) {
56 40         70 local $Test2::Compare::Type::verifying = 1;
57 2     2   14 no strict 'refs';
  2         4  
  2         391  
58 40   100     205 $result &&= "Test2::Tools::Type::is_$type"->($got);
59             } else {
60 8   100     43 $result &&= !compare($got, $type, \&strict_convert);
61             }
62             }
63 25 100       3373 $result = !$result if($self->{+NEGATE});
64 25         99 return $result;
65             }
66              
67             1;
68              
69             =head1 NAME
70              
71             Test2::Compare::Type - Use a type to validate values in a deep comparison.
72              
73             =head1 DESCRIPTION
74              
75             This allows you to validate a value's type in a deep comparison.
76             Sometimes a value just needs to look right, it may not need to be exact. An
77             example is that you care that your code always returns an integer, but you
78             don't care whether it is 192 or 3.
79              
80             =head1 CAVEATS
81              
82             The definitions of Boolean, integer and number are exactly the same as those in
83             L, which this is a thin wrapper around.
84              
85             =head1 SEE ALSO
86              
87             L
88              
89             L
90              
91             L
92              
93             =head1 BUGS
94              
95             If you find any bugs please report them on Github, preferably with a test case.
96              
97             =head1 FEEDBACK
98              
99             I welcome feedback about my code, especially constructive criticism.
100              
101             =head1 AUTHOR, COPYRIGHT and LICENCE
102              
103             Mostly cargo-culted from L. Differences from that are
104             Copyright 2024 David Cantrell EFE
105              
106             This software is free-as-in-speech software, and may be used,
107             distributed, and modified under the terms of either the GNU
108             General Public Licence version 2 or the Artistic Licence. It's
109             up to you which one you use. The full text of the licences can
110             be found in the files GPL2.txt and ARTISTIC.txt, respectively.
111              
112             =head1 CONSPIRACY
113              
114             This module is also free-as-in-mason software.
115              
116             =cut