summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/Test/Deep/Cache/Simple.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Test/Deep/Cache/Simple.pm')
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Test/Deep/Cache/Simple.pm81
1 files changed, 81 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Test/Deep/Cache/Simple.pm b/Master/tlpkg/tlperl0/lib/Test/Deep/Cache/Simple.pm
new file mode 100755
index 00000000000..e8e76a41438
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Test/Deep/Cache/Simple.pm
@@ -0,0 +1,81 @@
+use strict;
+use warnings;
+
+package Test::Deep::Cache::Simple;
+use Carp qw( confess );
+
+use Scalar::Util qw( refaddr );
+
+BEGIN
+{
+ if (grep /^weaken$/, @Scalar::Util::EXPORT_FAIL)
+ {
+ # we're running on a version of perl that has no weak refs, so we
+ # just install a no-op sub for weaken instead of importing it
+ *weaken = sub {};
+ }
+ else
+ {
+ Scalar::Util->import('weaken');
+ }
+}
+
+sub new
+{
+ my $pkg = shift;
+
+ my $self = bless {}, $pkg;
+
+ return $self;
+}
+
+sub add
+{
+ my $self = shift;
+
+ my ($d1, $d2) = @_;
+ {
+ local $SIG{__DIE__};
+
+ # cannot weaken read only refs, no harm if we can't as they never
+ # disappear
+ eval{weaken($d1)};
+ eval{weaken($d2)};
+ }
+
+ $self->{fn_get_key(@_)} = [$d1, $d2];
+}
+
+sub cmp
+{
+ my $self = shift;
+
+ my $key = fn_get_key(@_);
+ my $pair = $self->{$key};
+
+ # are both weakened refs still valid, if not delete this entry
+ if (ref($pair->[0]) and ref($pair->[1]))
+ {
+ return 1;
+ }
+ else
+ {
+ delete $self->{$key};
+ return 0;
+ }
+}
+
+sub absorb
+{
+ my $self = shift;
+
+ my $other = shift;
+
+ @{$self}{keys %$other} = values %$other;
+}
+
+sub fn_get_key
+{
+ return join(",", sort (map {refaddr($_)} @_));
+}
+1;