File Coverage

File:local/lib/perl5/Test/Deep/Cache/Simple.pm
Coverage:80.7%

linestmtbrancondsubtimecode
1
6
6
6
6
11
3
82
use strict;
2
6
6
6
6
11
3
89
use warnings;
3
4package Test::Deep::Cache::Simple;
5
6
6
6
6
10
4
123
use Carp qw( confess );
6
7
6
6
6
6
13
2
348
use Scalar::Util qw( refaddr );
8
9BEGIN
10{
11
6
50
6
13
  if (grep /^weaken$/, @Scalar::Util::EXPORT_FAIL)
12  {
13    # we're running on a version of perl that has no weak refs, so we
14    # just install a no-op sub for weaken instead of importing it
15
0
0
    *weaken = sub {};
16  }
17  else
18  {
19
6
895
    Scalar::Util->import('weaken');
20  }
21}
22
23sub new
24{
25
216
216
95
        my $pkg = shift;
26
27
216
192
        my $self = bless {}, $pkg;
28
29
216
281
        return $self;
30}
31
32sub add
33{
34
132
132
68
        my $self = shift;
35
36
132
88
        my ($d1, $d2) = @_;
37        {
38
132
132
56
194
                local $SIG{__DIE__};
39
40                # cannot weaken read only refs, no harm if we can't as they never
41                # disappear
42
132
132
71
121
                eval{weaken($d1)};
43
132
132
75
205
                eval{weaken($d2)};
44        }
45
46
132
160
        $self->{fn_get_key(@_)} = [$d1, $d2];
47}
48
49sub cmp
50{
51
264
264
127
        my $self = shift;
52
53
264
193
        my $key = fn_get_key(@_);
54
264
195
        my $pair = $self->{$key};
55
56        # are both weakened refs still valid, if not delete this entry
57
264
50
33
320
        if (ref($pair->[0]) and ref($pair->[1]))
58        {
59
0
0
                return 1;
60        }
61        else
62        {
63
264
161
                delete $self->{$key};
64
264
454
                return 0;
65        }
66}
67
68sub absorb
69{
70
0
0
0
        my $self = shift;
71
72
0
0
        my $other = shift;
73
74
0
0
0
0
        @{$self}{keys %$other} = values %$other;
75}
76
77sub fn_get_key
78{
79
396
792
396
227
1069
        return join(",", sort (map {refaddr($_)} @_));
80}
811;