r65918 - in /branches/upstream/libtie-refhash-weak-perl: ./ current/ current/lib/ current/lib/Tie/ current/lib/Tie/RefHash/ current/t/
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Fri Dec 17 09:26:28 UTC 2010
Author: dmn
Date: Fri Dec 17 09:26:20 2010
New Revision: 65918
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=65918
Log:
[svn-inject] Installing original source of libtie-refhash-weak-perl (0.09)
Added:
branches/upstream/libtie-refhash-weak-perl/
branches/upstream/libtie-refhash-weak-perl/current/
branches/upstream/libtie-refhash-weak-perl/current/Changes
branches/upstream/libtie-refhash-weak-perl/current/MANIFEST
branches/upstream/libtie-refhash-weak-perl/current/MANIFEST.SKIP
branches/upstream/libtie-refhash-weak-perl/current/META.yml
branches/upstream/libtie-refhash-weak-perl/current/Makefile.PL
branches/upstream/libtie-refhash-weak-perl/current/SIGNATURE
branches/upstream/libtie-refhash-weak-perl/current/TODO
branches/upstream/libtie-refhash-weak-perl/current/lib/
branches/upstream/libtie-refhash-weak-perl/current/lib/Tie/
branches/upstream/libtie-refhash-weak-perl/current/lib/Tie/RefHash/
branches/upstream/libtie-refhash-weak-perl/current/lib/Tie/RefHash/Weak.pm
branches/upstream/libtie-refhash-weak-perl/current/t/
branches/upstream/libtie-refhash-weak-perl/current/t/01basic.t
branches/upstream/libtie-refhash-weak-perl/current/t/02gc.t
branches/upstream/libtie-refhash-weak-perl/current/t/fieldhash.t
branches/upstream/libtie-refhash-weak-perl/current/t/overload.t
branches/upstream/libtie-refhash-weak-perl/current/t/thread_clone.t
Added: branches/upstream/libtie-refhash-weak-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/Changes?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/Changes (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/Changes Fri Dec 17 09:26:20 2010
@@ -1,0 +1,30 @@
+0.09
+ - Filter dead refs from the magic data storage to avoid uninitialized
+ warnings.
+
+0.08
+ - Add fieldhash compatibility API (by Father Chrysostomos)
+ - Fix overloading edge cases (Father Chrysostomos)
+ - Fix REF type references (really scalars) (Father Chrysostomos)
+
+0.07
+ - Warn when trying to store keys that are shared subrefs (they never get garbage collected)
+
+0.06
+ - Fix a silly typo
+
+0.05
+ - Weaken the entries in the magic array of $selfs
+
+0.04
+ - Variable::Magic doesn't do more than one instance of a given magic per
+ SV, so the data is now an array of objects
+
+0.03
+ - Use Variable::Magic to kill stale keys immediately, preventing value leaks
+
+0.02
+ - Fix overload::StrVal behavior (broken by Tie::RefHash change), thanks to Hans Dieter Pearcey
+
+0.01
+ - Initial release
Added: branches/upstream/libtie-refhash-weak-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/MANIFEST?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/MANIFEST (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/MANIFEST Fri Dec 17 09:26:20 2010
@@ -1,0 +1,13 @@
+Changes
+lib/Tie/RefHash/Weak.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
+META.yml
+t/01basic.t
+t/02gc.t
+t/fieldhash.t
+t/overload.t
+t/thread_clone.t
+TODO
+SIGNATURE Public-key signature (added by MakeMaker)
Added: branches/upstream/libtie-refhash-weak-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/MANIFEST.SKIP?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/MANIFEST.SKIP Fri Dec 17 09:26:20 2010
@@ -1,0 +1,38 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\b_darcs\b
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+
+# Avoid Devel::Cover files.
+\bcover_db\b
+
+### DEFAULT MANIFEST.SKIP ENDS HERE ####
+
+\.DS_Store$
+\.sw.$
+\.tar\.gz$
+^(\w+-)*(\w+)-\d\.\d+$
+
Added: branches/upstream/libtie-refhash-weak-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/META.yml?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/META.yml (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/META.yml Fri Dec 17 09:26:20 2010
@@ -1,0 +1,16 @@
+--- #YAML:1.0
+name: Tie-RefHash-Weak
+version: 0.09
+abstract: ~
+license: ~
+author: ~
+generated_by: ExtUtils::MakeMaker version 6.44
+distribution_type: module
+requires:
+ Scalar::Util: 0
+ Task::Weaken: 0
+ Tie::RefHash: 1.34
+ Variable::Magic: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Added: branches/upstream/libtie-refhash-weak-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/Makefile.PL?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/Makefile.PL (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/Makefile.PL Fri Dec 17 09:26:20 2010
@@ -1,0 +1,20 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Tie::RefHash::Weak',
+ VERSION_FROM => 'lib/Tie/RefHash/Weak.pm',
+ INSTALLDIRS => 'site',
+ SIGN => 1,
+ PL_FILES => { },
+ PREREQ_PM => {
+ 'Task::Weaken' => 0, # no weak refs before this
+ 'Scalar::Util' => 0,
+ 'Tie::RefHash' => '1.34', # use refaddr instead of overload::StrVal
+ 'Variable::Magic' => 0,
+ },
+);
+
Added: branches/upstream/libtie-refhash-weak-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/SIGNATURE?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/SIGNATURE (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/SIGNATURE Fri Dec 17 09:26:20 2010
@@ -1,0 +1,35 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.55.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It will check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 cca661de3f7fb9b941393af161431adbff5034d4 Changes
+SHA1 08bb8f7c311a8361b0d1defe78b146f4e78bb3df MANIFEST
+SHA1 ddb918d4e02cc06f4b9fe77adeca65403f8fdd56 MANIFEST.SKIP
+SHA1 126321f7e957f409ff08ee7c3d9c61ebe7542fff META.yml
+SHA1 671cb0205c15d3d680eb7bdc577731c886080282 Makefile.PL
+SHA1 e5e7fbf8ee6bd82b6a57f51901c9e836d40bfcd8 TODO
+SHA1 bdc9edd09d0426c0af2abfecb75eca1b8bde211a lib/Tie/RefHash/Weak.pm
+SHA1 264cbe5dd6df60229b9da06a7d389deb2876d417 t/01basic.t
+SHA1 58b89b0f01b67805ee99d923008b618a8b6ce4a3 t/02gc.t
+SHA1 e26274f99f7fca5a1ae27e76944c37fc3d58bca5 t/fieldhash.t
+SHA1 be0dab62022a0174c9ac4a6e2b467fbf211ee64a t/overload.t
+SHA1 e291095ccf408d33daa7fb7c94aaf3b7fd2fec65 t/thread_clone.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.7 (Darwin)
+
+iD8DBQFI+WLoVCwRwOvSdBgRAsqiAKC90eoP4heA5rITQ8LWKVgNY7r+mQCfWqOY
+D2jSXv+uf4s7Y40hhVea6u8=
+=3bZi
+-----END PGP SIGNATURE-----
Added: branches/upstream/libtie-refhash-weak-perl/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/TODO?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/TODO (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/TODO Fri Dec 17 09:26:20 2010
@@ -1,0 +1,2 @@
+- stop leaking magic
+- should $self be weakened in the magic data?
Added: branches/upstream/libtie-refhash-weak-perl/current/lib/Tie/RefHash/Weak.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/lib/Tie/RefHash/Weak.pm?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/lib/Tie/RefHash/Weak.pm (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/lib/Tie/RefHash/Weak.pm Fri Dec 17 09:26:20 2010
@@ -1,0 +1,204 @@
+#!/usr/bin/perl
+
+package Tie::RefHash::Weak;
+use base qw/Tie::RefHash Exporter/;
+
+use strict;
+use warnings;
+
+use warnings::register;
+
+use overload ();
+
+use B qw/svref_2object CVf_CLONED/;
+
+our $VERSION = 0.09;
+our @EXPORT_OK = qw 'fieldhash fieldhashes';
+our %EXPORT_TAGS = ( all => \@EXPORT_OK );
+
+use Scalar::Util qw/weaken reftype/;
+use Variable::Magic qw/wizard cast getdata/;
+
+my $wiz = wizard free => \&_clear_weakened_sub, data => \&_add_magic_data;
+
+sub _clear_weakened_sub {
+ my ( $key, $objs ) = @_;
+ local $@;
+ foreach my $self ( grep { defined } @{ $objs || [] } ) {
+ eval { $self->_clear_weakened($key) }; # support subclassing
+ }
+}
+
+sub _add_magic_data {
+ my ( $key, $objects ) = @_;
+ $objects;
+}
+
+sub _clear_weakened {
+ my ( $self, $key ) = @_;
+
+ $self->DELETE( $key );
+}
+
+sub STORE {
+ my($s, $k, $v) = @_;
+
+ if (ref $k) {
+ # make sure we use the same function that RefHash is using for ref keys
+ my $kstr = Tie::RefHash::refaddr($k);
+ my $entry = [$k, $v];
+
+ weaken( $entry->[0] );
+
+ my $objects;
+
+ if ( reftype $k eq 'CODE' ) {
+ unless ( svref_2object($k)->CvFLAGS & CVf_CLONED ) {
+ warnings::warnif("Non closure code references never get garbage collected: $k");
+ } else {
+ $objects = &getdata ( $k, $wiz )
+ or &cast( $k, $wiz, ( $objects = [] ) );
+ }
+ } else {
+ $objects = &getdata( $k, $wiz )
+ or &cast( $k, $wiz, ( $objects = [] ) );
+ }
+
+ @$objects = grep { defined } @$objects;
+
+ unless ( grep { $_ == $s } @$objects ) {
+ push @$objects, $s;
+ weaken($objects->[-1]);
+ }
+
+ $s->[0]{$kstr} = $entry;
+ }
+ else {
+ $s->[1]{$k} = $v;
+ }
+
+ $v;
+}
+
+sub fieldhash(\%) {
+ tie %{$_[0]}, __PACKAGE__;
+ return $_[0];
+}
+
+sub fieldhashes {
+ tie %{$_}, __PACKAGE__ for @_;
+ return @_;
+}
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Tie::RefHash::Weak - A Tie::RefHash subclass with weakened references in the keys.
+
+=head1 SYNOPSIS
+
+ use Tie::RefHash::Weak;
+ tie my %h, 'Tie::RefHash::Weak';
+
+ # OR:
+
+ use Tie::RefHash::Weak 'fieldhash';
+ fieldhash my %h;
+
+ { # new scope
+ my $val = "foo";
+
+ $h{\$val} = "bar"; # key is weak ref
+
+ print join(", ", keys %h); # contains \$val, returns regular reference
+ }
+ # $val goes out of scope, refcount goes to zero
+ # weak references to \$val are now undefined
+
+ keys %h; # no longer contains \$val
+
+ # see also Tie::RefHash
+
+=head1 DESCRIPTION
+
+The L<Tie::RefHash> module can be used to access hashes by reference. This is
+useful when you index by object, for example.
+
+The problem with L<Tie::RefHash>, and cross indexing, is that sometimes the
+index should not contain strong references to the objecs. L<Tie::RefHash>'s
+internal structures contain strong references to the key, and provide no
+convenient means to make those references weak.
+
+This subclass of L<Tie::RefHash> has weak keys, instead of strong ones. The
+values are left unaltered, and you'll have to make sure there are no strong
+references there yourself.
+
+=head1 FUNCTIONS
+
+For compatibility with L<Hash::Util::FieldHash>, this module will, upon
+request, export the following two functions. You may also write
+C<use Tie::RefHash::Weak ':all'>.
+
+=over 4
+
+=item fieldhash %hash
+
+This ties the hash and returns a reference to it.
+
+=item fieldhashes \%hash1, \%hash2 ...
+
+This ties each hash that is passed to it as a reference. It returns the
+list of references in list context, or the number of hashes in scalar
+context.
+
+=back
+
+=head1 THREAD SAFETY
+
+L<Tie::RefHash> version 1.32 and above have correct handling of threads (with
+respect to changing reference addresses). If your module requires
+Tie::RefHash::Weak to be thread aware you need to depend on both
+L<Tie::RefHash::Weak> and L<Tie::RefHash> version 1.32 (or later).
+
+Version 0.02 and later of Tie::RefHash::Weak depend on a thread-safe version of
+Tie::RefHash anyway, so if you are using the latest version this should already
+be taken care of for you.
+
+=head1 5.10.0 COMPATIBILITY
+
+Due to a minor change in Perl 5.10.0 a bug in the handling of magic freeing was
+uncovered causing segmentation faults.
+
+This has been patched but not released yet, as of 0.08.
+
+=head1 CAVEAT
+
+You can use an LVALUE reference (such as C<\substr ...>) as a hash key, but
+due to a bug in perl (see
+L<http://rt.perl.org/rt3/Public/Bug/Display.html?id=46943>) it might not be
+possible to weaken a reference to it, in which case the hash element will
+never be deleted automatically.
+
+=head1 AUTHORS
+
+Yuval Kogman <nothingmuch at woobling.org>
+
+some maintenance by Hans Dieter Pearcey <hdp at pobox.com>
+
+=head1 COPYRIGHT & LICENSE
+
+ Copyright (c) 2004 Yuval Kogman. All rights reserved
+ This program is free software; you can redistribute
+ it and/or modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Tie::RefHash>, L<Class::DBI> (the live object cache),
+L<mg.c/Perl_magic_killbackrefs>
+
+=cut
Added: branches/upstream/libtie-refhash-weak-perl/current/t/01basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/t/01basic.t?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/t/01basic.t (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/t/01basic.t Fri Dec 17 09:26:20 2010
@@ -1,0 +1,112 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 26;
+
+use Scalar::Util qw/weaken/;
+
+BEGIN { use_ok("Tie::RefHash::Weak") };
+
+tie my %hash, "Tie::RefHash::Weak";
+
+isa_ok(tied %hash, "Tie::RefHash::Weak", 'tied(%hash)');
+
+my $val = "foo";
+
+$hash{blah} = $val;
+is_deeply([ keys %hash ], [ "blah" ], "keys returns 'blah'");
+
+is($hash{blah}, $val, "normal string as key");
+
+my $delete_is_borked;
+SKIP: {
+ my $deleted = delete($hash{blah});
+
+ use Tie::RefHash;
+ tie my %refhash, 'Tie::RefHash';
+ $refhash{foo} = 1;
+ my $r = [];
+ $refhash{$r} = 2;
+
+ unless (delete($refhash{foo}) == 1 and delete($refhash{$r}) == 2) {
+ $delete_is_borked=1;
+ skip "Tie::RefHash::delete is broken", 1;
+ }
+
+ is($deleted, $val, "delete returns value");
+}
+ok(!exists($hash{blah}), "deleted value no longer exists()");
+
+my $ref = \$val;
+
+$hash{$ref} = $val;
+is($hash{$ref}, $val, "ref as key");
+is_deeply([ keys %hash ], [ $ref ], "keys returns ref");
+ok(exists($hash{$ref}), "existing value exists()");
+SKIP: {
+ my $deleted = delete($hash{$ref});
+ skip "Tie::RefHash::delete is broken", 1 if $delete_is_borked;
+ is($deleted, $val, "delete returns value");
+}
+ok(!exists($hash{$ref}), "deleted value no longer exists()");
+is_deeply([ keys %hash ], [ ], "no keys in hash");
+
+
+{
+ my $goner = "blech";
+ $ref = \$goner;
+ weaken($ref);
+
+ $hash{$ref} = "foo";
+
+ is($hash{$ref}, "foo", "ref as key");
+ is_deeply([ keys %hash ], [ $ref ], "keys returns ref");
+ ok(exists($hash{$ref}), "existing value exists()");
+}
+
+# $goner has droppped out of scope
+is($ref, undef, "reference was undefined");
+
+is_deeply([ values %hash ], [], "no values in hash");
+
+is(scalar keys %hash, 0, "scalar keys returns 0");
+is_deeply([ keys %hash ], [] , "keys returns emtpy list");
+
+
+{
+ my $bar = 1;
+ my $closure = sub { fail("should never execute"); $bar };
+ $hash{$closure} = "blah";
+ is( $hash{$closure}, "blah", "code ref key" );
+}
+
+is_deeply([ keys %hash ], [], "no more keys" );
+
+%hash = ();
+
+my @w;
+$SIG{__WARN__} = sub { push @w, "@_" };
+
+{
+ no warnings 'Tie::RefHash::Weak';
+ my $sub = sub { fail("should never execute") };
+ $hash{$sub} = "boo";
+ is( $hash{$sub}, "boo", "code ref key" );
+}
+
+is( scalar(@w), 0, "no warnings (disabled");
+
+{
+ local $TODO = "perl doesn't GC non closures";
+ is_deeply([ keys %hash ], [], "no more keys" );
+}
+
+ at w = ();
+%hash = ();
+
+$hash{sub { }} = 1;
+
+is( scalar(@w), 1, "got a warning" );
+like( $w[0], qr/never get garbage collected/i, "right warning" );
Added: branches/upstream/libtie-refhash-weak-perl/current/t/02gc.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/t/02gc.t?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/t/02gc.t (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/t/02gc.t Fri Dec 17 09:26:20 2010
@@ -1,0 +1,66 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Symbol qw 'gensym geniosym';
+
+BEGIN { use_ok("Tie::RefHash::Weak") }
+
+sub Tie::RefHash::Weak::cnt {
+ my $s = shift;
+ scalar keys %{ $s->[0] }
+}
+
+my @types = (
+ sub { my $v = shift; \$v }, # SCALAR
+ sub { my $v = shift; \\$v }, # REF
+ sub { my $v = shift; \substr $v, 0 }, # LVALUE
+ sub { [ $_[0] ] }, # ARRAY
+ sub { { value => $_[0] } }, # HASH
+ sub { gensym }, # GLOB
+ sub { geniosym }, # IO
+ sub { my $v = shift; sub { $v } }, # CODE
+);
+my $secret_vault = $types[2]->(''); # workaround for a perl bug
+
+my $n = 10; # create a large hunk of
+
+tie my %hash, 'Tie::RefHash::Weak';
+tie my %hash_2, 'Tie::RefHash::Weak';
+
+my @copies = map {bless new_ref($_), "Some::Class"} 1 .. 1 << $n;
+
+ at hash{@copies} = (1) x @copies;
+ at hash_2{@copies} = (1) x @copies;
+
+sub new_ref {
+ my $v = shift;
+ push @types, my $h = shift @types;
+ $h->( $v );
+}
+
+is(scalar keys %hash_2, 1 << $n, "scalar keys");
+is(scalar keys %hash, 1 << $n, "scalar keys");
+is((tied %hash)->cnt, 1 << $n, "cnt");
+
+splice(@copies, 0, 1 << ($n-1)); # throw some away
+
+is((tied %hash)->cnt, 1 << ($n-1), "cnt");
+is((tied %hash_2)->cnt, 1 << ($n-1), "cnt");
+is(scalar keys %hash, 1 << ($n-1), "scalar keys");
+is(scalar keys %hash_2, 1 << ($n-1), "scalar keys");
+
+splice(@copies, 0, 1 << ($n-2)); # throw some away
+
+for (my $i = 0; $i <= 1 << $n; $i++){
+ exists $hash{$copies[-$i] || 'foo'};
+ $hash{$copies[-$i] || 'foo'}++;
+}
+
+is((tied %hash)->cnt, 1 << ($n-2), "cnt");
+
+ at copies = ();
+
+is((tied %hash)->cnt, 0, "cnt" );
Added: branches/upstream/libtie-refhash-weak-perl/current/t/fieldhash.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/t/fieldhash.t?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/t/fieldhash.t (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/t/fieldhash.t Fri Dec 17 09:26:20 2010
@@ -1,0 +1,26 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+BEGIN { use_ok("Tie::RefHash::Weak", ':all') };
+
+my $thing = fieldhash my %fieldmouse;
+
+isa_ok(tied %fieldmouse, "Tie::RefHash::Weak", 'tied(%hash)');
+is $thing, \%fieldmouse, 'return val of fieldhash';
+
+$thing = fieldhashes \my %hash1, \my %hash2;
+
+isa_ok(tied %hash1, "Tie::RefHash::Weak", '%hash1 tied by fieldhashes()');
+isa_ok(tied %hash2, "Tie::RefHash::Weak", '%hash2 tied by fieldhashes()');
+is $thing, 2, 'return val of fieldhashes (scalar)';
+
+my(%foo, %bar);
+
+is_deeply [map "$_", fieldhashes\(%foo, %bar)],
+ [map "$_", \(%foo, %bar)],
+ 'return val of fieldhashes (list)';
+
Added: branches/upstream/libtie-refhash-weak-perl/current/t/overload.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/t/overload.t?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/t/overload.t (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/t/overload.t Fri Dec 17 09:26:20 2010
@@ -1,0 +1,61 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use Scalar::Util 'weaken';
+use Symbol qw 'gensym geniosym';
+
+BEGIN { use_ok("Tie::RefHash::Weak") };
+
+tie my %hash, "Tie::RefHash::Weak";
+
+{ package overloaded;
+ use overload fallback => 1,
+ '${}' => sub { \my $v },
+ '@{}' => sub { [] },
+ '%{}' => sub { +{} },
+ '&{}' => sub { my $v; sub { $v } },
+ '*{}' => sub { Symbol::gensym },
+}
+
+my @types = (
+ sub { \my $v }, # SCALAR
+ sub { \\my $v }, # REF
+ sub { \substr my $v = '', 0 }, # LVALUE
+ sub { [] }, # ARRAY
+ sub { +{} }, # HASH
+ sub { gensym }, # GLOB
+ sub { geniosym }, # IO
+ sub { my $v; sub { $v } }, # CODE
+);
+
+my @refs = map { &$_, bless &$_, "overloaded"} @types;
+
+ at hash{@refs} = (1) x @refs;
+
+is_deeply
+ [sort(map Tie::RefHash::refaddr($_), keys %hash)],
+ [sort(map Tie::RefHash::refaddr($_), @refs )],
+ 'elements with overloaded keys can be created';
+
+
+ at refs = map { &$_, bless &$_, "overloaded"} @types;
+
+# we'll make sure these are freed:
+weaken $_ for my @copies = @refs;
+my $value = [];
+
+%hash = (); # start from scratch
+ at hash{@refs} = ($value) x @refs;
+weaken $value;
+
+is scalar keys %hash, @refs, 'number of keys to begin with';
+
+ at refs = ();
+
+is grep(defined, @copies), 0, 'the keys were freed';
+is $value, undef, 'the value was freed';
+
+is scalar keys %hash, 0, 'elements with overloaded keys are freed';
Added: branches/upstream/libtie-refhash-weak-perl/current/t/thread_clone.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtie-refhash-weak-perl/current/t/thread_clone.t?rev=65918&op=file
==============================================================================
--- branches/upstream/libtie-refhash-weak-perl/current/t/thread_clone.t (added)
+++ branches/upstream/libtie-refhash-weak-perl/current/t/thread_clone.t Fri Dec 17 09:26:20 2010
@@ -1,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+BEGIN {
+ # this is sucky because threads.pm has to be loaded before Test::Builder
+ use Config;
+ if ( $Config{usethreads} ) {
+ require threads; threads->import;
+ require Test::More; Test::More->import( tests => 14 );
+ } else {
+ require Test::More;
+ Test::More->import( skip_all => "threads aren't enabled in your perl" )
+ }
+}
+
+use Tie::RefHash;
+
+tie my %hash, "Tie::RefHash";
+
+my $r1 = {};
+my $r2 = [];
+my $v1 = "foo";
+
+$hash{$r1} = "hash";
+$hash{$r2} = "array";
+$hash{$v1} = "string";
+
+is( $hash{$v1}, "string", "fetch by string before clone ($v1)" );
+is( $hash{$r1}, "hash", "fetch by ref before clone ($r1)" );
+is( $hash{$r2}, "array", "fetch by ref before clone ($r2)" );
+
+my $th = threads->create(sub {
+ is( scalar keys %hash, 3, "key count is OK" );
+
+ ok( exists $hash{$v1}, "string key exists ($v1)" );
+ is( $hash{$v1}, "string", "fetch by string" );
+
+ ok( exists $hash{$r1}, "ref key exists ($r1)" );
+ is( $hash{$r1}, "hash", "fetch by ref" );
+
+ ok( exists $hash{$r2}, "ref key exists ($r2)" );
+ is( $hash{$r2}, "array", "fetch by ref" );
+
+ is_deeply( [ sort keys %hash ], [ sort $r1, $r2, $v1 ], "keys are ok" );
+});
+
+$th->join;
+
+is( $hash{$v1}, "string", "fetch by string after clone, orig thread ($v1)" );
+is( $hash{$r1}, "hash", "fetch by ref after clone ($r1)" );
+is( $hash{$r2}, "array", "fetch by ref after clone ($r2)" );
More information about the Pkg-perl-cvs-commits
mailing list