File Coverage

blib/lib/Switch/Perlish/Smatch/Scalar.pm
Criterion Covered Total %
statement 25 27 92.5
branch n/a
condition 4 4 100.0
subroutine 10 11 90.9
pod n/a
total 39 42 92.8


line stmt bran cond sub pod time code
1             package Switch::Perlish::Smatch::Scalar;
2              
3             $VERSION = '1.0.0';
4              
5 11     11   61 use strict;
  11         24  
  11         395  
6 11     11   55 use warnings;
  11         19  
  11         545  
7              
8 11     11   60 use Switch::Perlish::Smatch 'value_cmp';
  11         17  
  11         17552  
9              
10             ## DESC - Call C with $$t and $m.
11             sub _VALUE {
12 2     2   4 my($t, $m) = @_;
13 2         7 return value_cmp($$t, $m);
14             }
15              
16             ## DESC - Check if $$t is undef.
17             sub _UNDEF {
18 1     1   3 my($t, $m) = @_;
19 1         7 return !defined($$t);
20             }
21              
22             ## DESC - Numerically compare the scalar refs.
23             sub _SCALAR {
24 5     5   7 my($t, $m) = @_;
25 5         36 return $t == $m;
26             }
27              
28             ## Not sure if this is the right thing to do.
29             ## DESC - Check if $t points to an element of @$m.
30             sub _ARRAY {
31 2     2   4 my($t, $m) = @_;
32             \$_ == $t and return 1
33 2   100     40 for @$m;
34 1         16 return;
35             }
36              
37             ## This is an awkward comparator.
38             ## DESC - Check if $t points to a value in %$m.
39             sub _HASH {
40 2     2   4 my($t, $m) = @_;
41             \$_ == $t and return 1
42 2   100     20 for values %$m;
43 1         25 return;
44             }
45              
46             ## DESC - Check if $t points to $m.
47             sub _CODE {
48 1     1   4 my($t, $m) = @_;
49 1         8 return $t == \$m;
50             }
51              
52             ## Another awkward comparator.
53             ## DESC - Check if the sref refers to the object.
54             sub _OBJECT {
55 3     3   5 my($t, $m) = @_;
56 3         34 return $$t == $m;
57             }
58              
59             ## Comparing scalar refs with other things doesn't feel right.
60             ## DESC - Check if the sref refers to the Regexp object.
61             sub _Regexp {
62 0     0     my($t, $m) = @_;
63 0           return $$t == $m;
64             }
65              
66             Switch::Perlish::Smatch->register_package( __PACKAGE__, 'SCALAR' );
67              
68             1;
69              
70             =pod
71              
72             =head1 NAME
73              
74             Switch::Perlish::Smatch::Scalar - The C comparatory category package.
75              
76             =head1 VERSION
77              
78             1.0.0 - Initial release.
79              
80             =head1 DESCRIPTION
81              
82             This package provides the default implementation for the C comparator
83             category. For more information on the comparator implementation see.
84             L.
85              
86             =head1 SEE. ALSO
87              
88             L.
89              
90             =head1 AUTHOR
91              
92             Dan Brook C<< >>
93              
94             =head1 COPYRIGHT
95              
96             Copyright (c) 2006, Dan Brook. All Rights Reserved. This module is free
97             software. It may be used, redistributed and/or modified under the same
98              
99             =cut