Hello community, here is the log from the commit of package perl-Set-Object for openSUSE:Factory checked in at 2013-06-05 13:06:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Set-Object (Old) and /work/SRC/openSUSE:Factory/.perl-Set-Object.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Set-Object" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Set-Object/perl-Set-Object.changes 2011-11-21 12:45:17.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.perl-Set-Object.new/perl-Set-Object.changes 2013-06-05 13:06:58.000000000 +0200 @@ -1,0 +2,14 @@ +Tue Jun 4 18:17:37 UTC 2013 - [email protected] + +- updated to 1.31 + Changes.pod patch by Gregor Hermann, debian perl group - RT#85244 + Fixes for 5.16 and newer - RT#83426 + Sort by member names, not the refs. + Fix wrong weak test with globals. Changed to lexicals and use strict/warnings. + Fix F<t/misc/segfault.t>, check SvMAGICAL before doing C<mg_find> + Fixed wrong C format types in warnings and C<SET_OBJECT_MAGIC_backref>. + Added PREREQ_PMs, make L<Test::LeakTrace> and L<Moose> an optional dependency + for F<t/misc/more_leaks.t> +- Obsoletes perl-Set-Object-1.28-return_value.diff + +------------------------------------------------------------------- Old: ---- Set-Object-1.28.tar.gz perl-Set-Object-1.28-return_value.diff New: ---- Set-Object-1.31.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Set-Object.spec ++++++ --- /var/tmp/diff_new_pack.m0nO2V/_old 2013-06-05 13:06:59.000000000 +0200 +++ /var/tmp/diff_new_pack.m0nO2V/_new 2013-06-05 13:06:59.000000000 +0200 @@ -1,7 +1,7 @@ # # spec file for package perl-Set-Object # -# Copyright (c) 2011 SUSE LINUX Products GmbH, Nuernberg, Germany. +# Copyright (c) 2013 SUSE LINUX Products GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -15,55 +15,58 @@ # Please submit bugfixes or comments via http://bugs.opensuse.org/ # -# norootforbuild - Name: perl-Set-Object -Version: 1.28 -Release: 3 -AutoReqProv: on -Group: Development/Libraries/Perl +Version: 1.31 +Release: 0 +%define cpan_name Set-Object +Summary: Unordered collections (sets) of Perl Objects License: Artistic-1.0 -Url: http://cpan.org/modules/by-module/Set -Summary: Set of objects -Source0: Set-Object-%{version}.tar.gz -Patch: %{name}-%{version}-return_value.diff +Group: Development/Libraries/Perl +Url: http://search.cpan.org/dist/Set-Object/ +Source: http://www.cpan.org/authors/id/R/RU/RURBAN/%{cpan_name}-%{version}.tar.gz BuildRoot: %{_tmppath}/%{name}-%{version}-build -%{perl_requires} BuildRequires: perl BuildRequires: perl-macros +#BuildRequires: perl(Moose) +#BuildRequires: perl(Set::Object) +#BuildRequires: perl(Set::Object::Weak) +Recommends: perl(Moose) +Recommends: perl(Test::LeakTrace) +%{perl_requires} %description -This module implements a Set of objects, that is, a collection of -objects without duplications. It is similar to a Smalltalk IdentitySet. - +This modules implements a set of objects, that is, an unordered collection +of objects without duplication. +The term _objects_ is applied loosely - for the sake of the Set::Object +manpage, anything that is a reference is considered an object. -Authors: --------- - Jean-Louis Leroy <[email protected]> +the Set::Object manpage 1.09 and later includes support for inserting +scalars (including the empty string, but excluding 'undef') as well as +objects. This can be thought of as (and is currently implemented as) a +degenerate hash that only has keys and no values. Unlike objects placed +into a Set::Object, scalars that are inserted will be flattened into +strings, so will lose any magic (eg, tie) or other special bits that they +went in with; only strings come out. %prep -%setup -q -n Set-Object-%{version} -%patch +%setup -q -n %{cpan_name}-%{version} %build -perl Makefile.PL OPTIMIZE="$RPM_OPT_FLAGS -Wall" -make %{?_smp_mflags} -make test +%{__perl} Makefile.PL INSTALLDIRS=vendor OPTIMIZE="%{optflags}" +%{__make} %{?_smp_mflags} + +%check +%{__make} test %install %perl_make_install %perl_process_packlist +%perl_gen_filelist -%clean -rm -rf $RPM_BUILD_ROOT - -%files -%defattr(-, root, root) -%doc Changes.pod README -%doc %{_mandir}/man?/* -%{perl_vendorarch}/Set -%{perl_vendorarch}/auto/Set +%files -f %{name}.files +%defattr(-,root,root,755) +%doc README %changelog ++++++ Set-Object-1.28.tar.gz -> Set-Object-1.31.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/Changes.pod new/Set-Object-1.31/Changes.pod --- old/Set-Object-1.28/Changes.pod 2010-07-22 08:18:21.000000000 +0200 +++ new/Set-Object-1.31/Changes.pod 2013-05-13 22:34:02.000000000 +0200 @@ -1,7 +1,75 @@ =encoding utf8 -=head1 REVISION HISTORY FOR Set::Object += + +=head1 NAME + +Set::Object - REVISION HISTORY + +=head1 1.31, 2013-05-13 rurban + +=over + +=item * + +Changes.pod patch by Gregor Hermann, debian perl group - RT#85244 + +=back + +=head1 1.30, 2013-04-04 rurban (new maintainer) + +=over + +=item * + +Fixes for 5.16 and newer - RT#83426 +Sort by member names, not the refs. +Fix wrong weak test with globals. Changed to lexicals and use strict/warnings. + +=item * + +Fix F<t/misc/segfault.t>, check SvMAGICAL before doing C<mg_find> + +=item * + +Fixed wrong C format types in warnings and C<SET_OBJECT_MAGIC_backref>. +Added PREREQ_PMs, make L<Test::LeakTrace> and L<Moose> an optional dependency +for F<t/misc/more_leaks.t> + +=item * + +Improve thread-safety (forbid concurrent writes), but still dealing with +Attempt to free non-existent shared string and +Unbalanced string table refcount: (1) for "8" during global destruction. +- RT #22760 + +=item * + +Add missing typemap entry const char * for 5.6 + +=back + +=head1 1.29, 13 Feb 2013 + +=over + +=item * + +Fixed a typo in a function which really shouldn't exist - RT#79653 + +=item * + +Marked a couple of functions as deprecated for removal (including the +above function). + +=item * + +Fixed the magic cleanup code to use the appropriate macro/function to +clean up the magic list instead of trying to do it itself. +Unsurprisingly, fixes a memory leak. (RT#69967, also RT#67289) + +=back =head1 1.28, 22 Jul 2010 @@ -392,7 +460,7 @@ Some of these functions were in the XS code anyway, and they are extremely small, so I didn't see a problem with duplicating them - -saves an extra dependancy. Plus, Graham Barr won't let me put +saves an extra dependency. Plus, Graham Barr won't let me put C<ish_int> or C<is_key> in his module. Knowing that they are available will also assist in fixing some longer diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/MANIFEST new/Set-Object-1.31/MANIFEST --- old/Set-Object-1.28/MANIFEST 2010-07-22 08:19:48.000000000 +0200 +++ new/Set-Object-1.31/MANIFEST 2013-05-13 22:34:20.000000000 +0200 @@ -6,11 +6,14 @@ Object.xs ppport.h README -SIGNATURE +typemap t/ingy/arrayref.t t/misc/leaks.t +t/misc/more_leaks.t t/misc/pod.t t/misc/pod_coverage.t +t/misc/segfault.t +t/misc/threads.t t/misc/undef.t t/object/abuse.t t/object/clear.t @@ -50,4 +53,6 @@ t/scalar/symmdiff.t t/scalar/union.t t/scalar/unique.t -META.yml Module meta-data (added by MakeMaker) +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) +SIGNATURE Public-key signature (added by MakeMaker) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/META.json new/Set-Object-1.31/META.json --- old/Set-Object-1.28/META.json 1970-01-01 01:00:00.000000000 +0100 +++ new/Set-Object-1.31/META.json 2013-05-13 22:34:20.000000000 +0200 @@ -0,0 +1,54 @@ +{ + "abstract" : "Unordered collections (sets) of Perl Objects", + "author" : [ + "Jean-Louis Leroy and Sam Vilain" + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.130880", + "license" : [ + "artistic_1" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";, + "version" : "2" + }, + "name" : "Set-Object", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "recommends" : { + "Moose" : "0", + "Test::LeakTrace" : "0" + }, + "requires" : { + "Scalar::Util" : "0", + "Test::More" : "0" + } + } + }, + "release_status" : "stable", + "resources" : { + "license" : [ + "http://dev.perl.org/licenses/"; + ], + "repository" : { + "url" : "git://github.com/rurban/Set-Object.git" + } + }, + "version" : "1.31" +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/META.yml new/Set-Object-1.31/META.yml --- old/Set-Object-1.28/META.yml 2010-07-22 08:19:48.000000000 +0200 +++ new/Set-Object-1.31/META.yml 2013-05-13 22:34:20.000000000 +0200 @@ -1,22 +1,29 @@ ---- #YAML:1.0 -name: Set-Object -version: 1.28 -abstract: Unordered collections (sets) of Perl Objects +--- +abstract: 'Unordered collections (sets) of Perl Objects' author: - - Jean-Louis Leroy and Sam Vilain -license: Artistic -distribution_type: module -configure_requires: - ExtUtils::MakeMaker: 0 + - 'Jean-Louis Leroy and Sam Vilain' build_requires: - ExtUtils::MakeMaker: 0 -requires: - Scalar::Util: 0 -no_index: - directory: - - t - - inc -generated_by: ExtUtils::MakeMaker version 6.55_02 + ExtUtils::MakeMaker: 0 +configure_requires: + ExtUtils::MakeMaker: 0 +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.130880' +license: artistic meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: Set-Object +no_index: + directory: + - t + - inc +recommends: + Moose: 0 + Test::LeakTrace: 0 +requires: + Scalar::Util: 0 + Test::More: 0 +resources: + license: http://dev.perl.org/licenses/ + repository: git://github.com/rurban/Set-Object.git +version: 1.31 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/Makefile.PL new/Set-Object-1.31/Makefile.PL --- old/Set-Object-1.28/Makefile.PL 2008-10-12 23:50:14.000000000 +0200 +++ new/Set-Object-1.31/Makefile.PL 2013-04-04 23:12:46.000000000 +0200 @@ -10,17 +10,29 @@ # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( - 'NAME' => 'Set::Object', - 'AUTHOR' => 'Jean-Louis Leroy and Sam Vilain', - 'LICENSE' => 'Artistic', - 'VERSION_FROM' => 'lib/Set/Object.pm', # finds $VERSION - 'ABSTRACT' => "Unordered collections (sets) of Perl Objects", - 'LIBS' => [''], # e.g., '-lm' - 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' - 'INC' => '', # e.g., '-I/usr/include/other' - PM => {'lib/Set/Object.pm' => '$(INST_LIBDIR)/Object.pm', - 'lib/Set/Object/Weak.pm' => '$(INST_LIBDIR)/Object/Weak.pm', - }, - PREREQ_PM => { 'Scalar::Util' => 0 }, - test => { TESTS => join(' ', glob('t/*/*.t')) }, + 'NAME' => 'Set::Object', + 'VERSION_FROM' => 'lib/Set/Object.pm', + 'AUTHOR' => 'Jean-Louis Leroy and Sam Vilain', + 'LICENSE' => 'Artistic', + 'ABSTRACT' => "Unordered collections (sets) of Perl Objects", + 'PREREQ_PM' => { + 'Scalar::Util' => 0, + 'Test::More' => 0, + }, + "SIGN" => 1, + ($ExtUtils::MakeMaker::VERSION gt '6.46' ? + ('META_MERGE' => + { + recommends => { + # deps of t/misc/more_leaks.t + 'Test::LeakTrace' => 0, + 'Moose' => 0, + }, + resources => { + license => 'http://dev.perl.org/licenses/', + repository => 'git://github.com/rurban/Set-Object.git', + } + }) : () + ), + test => { TESTS => join(' ', glob('t/*/*.t')) }, ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/Object.xs new/Set-Object-1.31/Object.xs --- old/Set-Object-1.28/Object.xs 2010-07-14 06:42:11.000000000 +0200 +++ new/Set-Object-1.31/Object.xs 2013-04-05 02:03:29.000000000 +0200 @@ -17,22 +17,29 @@ #define _warn warn #endif +#ifdef SET_DEBUG /* for debugging object-related functions */ #define IF_DEBUG(e) - /* for debugging scalar-related functions */ -#define IF_REMOVE_DEBUG(e) +#define IF_REMOVE_DEBUG(e) e #define IF_INSERT_DEBUG(e) - /* for debugging weakref-related functions */ +#define IF_SPELL_DEBUG(e) e +#else +#define IF_DEBUG(e) +#define IF_REMOVE_DEBUG(e) +#define IF_INSERT_DEBUG(e) #define IF_SPELL_DEBUG(e) +#endif #if (PERL_VERSION > 7) || ( (PERL_VERSION == 7)&&( PERL_SUBVERSION > 2)) -#define SET_OBJECT_MAGIC_backref (char)0x9f +#define SET_OBJECT_MAGIC_backref (int)((char)0x9f) #else #define SET_OBJECT_MAGIC_backref '~' #endif +#define __PACKAGE__ "Set::Object" + typedef struct _BUCKET { SV** sv; @@ -47,6 +54,31 @@ HV* flat; } ISET; +#ifdef USE_ITHREADS +# define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION +# ifndef MY_CXT_CLONE +# define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +# endif + +typedef struct { + ISET *s; +} my_cxt_t; + +STATIC perl_mutex iset_mutex; + +START_MY_CXT +# define THR_LOCK MUTEX_LOCK(&iset_mutex) +# define THR_UNLOCK MUTEX_UNLOCK(&iset_mutex) + +#else +# define THR_LOCK +# define THR_UNLOCK +#endif + #define ISET_HASH(el) ((PTR2UV(el)) >> 4) #define ISET_INSERT(s, item) \ @@ -54,6 +86,9 @@ ? iset_insert_one(s, item) \ : iset_insert_scalar(s, item) ) +int iset_remove_one(ISET* s, SV* el, int spell_in_progress); + + int insert_in_bucket(BUCKET* pb, SV* sv) { if (!pb->sv) @@ -61,7 +96,7 @@ New(0, pb->sv, 1, SV*); pb->sv[0] = sv; pb->n = 1; - IF_DEBUG(_warn("inserting 0x%.8x in bucket 0x%.8x offset %d", sv, pb, 0)); + IF_DEBUG(_warn("inserting %p in bucket %p offset %d", sv, pb, 0)); } else { @@ -87,9 +122,8 @@ *hole = sv; - IF_DEBUG(_warn("inserting 0x%.8x in bucket 0x%.8x offset %d", sv, pb, iter - pb->sv)); + IF_DEBUG(_warn("inserting %p in bucket %p offset %ld", sv, pb, iter - pb->sv)); } - return 1; } @@ -99,7 +133,7 @@ char* key = 0; if (!s->flat) { - IF_INSERT_DEBUG(_warn("iset_insert_scalar(%x): creating scalar hash", s)); + IF_INSERT_DEBUG(_warn("iset_insert_scalar(%p): creating scalar hash", s)); s->flat = newHV(); } @@ -107,25 +141,24 @@ return 0; key = SvPV(sv, len); + IF_INSERT_DEBUG(_warn("iset_insert_scalar(%p): sv (%p, rc = %d, str= '%s')!", s, sv, SvREFCNT(sv), SvPV_nolen(sv))); - IF_INSERT_DEBUG(_warn("iset_insert_scalar(%x): sv (%x, rc = %d, str= '%s')!", s, sv, SvREFCNT(sv), SvPV_nolen(sv))); - + THR_LOCK; if (!hv_exists(s->flat, key, len)) { - if (!hv_store(s->flat, key, len, &PL_sv_undef, 0)) { - _warn("hv store failed[?] set=%x", s); + THR_UNLOCK; + _warn("hv store failed[?] set=%p", s); + } else { + THR_UNLOCK; } - - IF_INSERT_DEBUG(_warn("iset_insert_scalar(%x): inserted OK!", s)); - + IF_INSERT_DEBUG(_warn("iset_insert_scalar(%p): inserted OK!", s)); return 1; } else { - - IF_INSERT_DEBUG(_warn("iset_insert_scalar(%x): already there!", s)); + THR_UNLOCK; + IF_INSERT_DEBUG(_warn("iset_insert_scalar(%p): already there!", s)); return 0; } - } int iset_remove_scalar(ISET* s, SV* sv) @@ -133,23 +166,31 @@ STRLEN len; char* key = 0; - if (!s->flat) { - IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%x): shortcut for %x(str = '%s') (no hash)", s, sv, SvPV_nolen(sv))); + if (!s->flat || !HvKEYS(s->flat)) { + //IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%p):'%s' (no hash)", s, SvPV_nolen(sv))); return 0; } - IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%x): sv (%x, rc = %d, str= '%s')!", s, sv, SvREFCNT(sv), SvPV_nolen(sv))); - + IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%p): sv (%p, rc=%d, str='%s')" +#ifdef USE_ITHREADS + " interp=%p" +#endif + , s, sv, SvREFCNT(sv), SvPV_nolen(sv) +#ifdef USE_ITHREADS + , PERL_GET_CONTEXT +#endif + )); key = SvPV(sv, len); + THR_LOCK; if ( hv_delete(s->flat, key, len, 0) ) { - - IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%x): deleted key", s)); + THR_UNLOCK; + IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%p): deleted key '%s'", s, key)); return 1; } else { - - IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%x): key not absent", s)); + THR_UNLOCK; + IF_REMOVE_DEBUG(_warn("iset_remove_scalar(%p): key '%s' not found", s, key)); return 0; } @@ -157,7 +198,7 @@ bool iset_includes_scalar(ISET* s, SV* sv) { - if (s->flat) { + if (s->flat && HvKEYS(s->flat)) { STRLEN len; char* key = SvPV(sv, len); return hv_exists(s->flat, key, len); @@ -176,9 +217,7 @@ int ins = 0; if (!SvROK(rv)) - { Perl_croak(aTHX_ "Tried to insert a non-reference into a Set::Object"); - }; el = SvRV(rv); @@ -196,11 +235,11 @@ ++s->elems; ++ins; if (s->is_weak) { - IF_DEBUG(_warn("rc of 0x%.8x left as-is, casting magic", el)); + IF_DEBUG(_warn("rc of %p left as-is, casting magic", el)); _cast_magic(s, el); } else { SvREFCNT_inc(el); - IF_DEBUG(_warn("rc of 0x%.8x bumped to %d", el, SvREFCNT(el))); + IF_DEBUG(_warn("rc of %p bumped to %d", el, SvREFCNT(el))); } } @@ -247,7 +286,7 @@ } new_bucket = bucket_first + index; - IF_DEBUG(_warn("0x%.8x moved from bucket %d:0x%.8x to %d:0x%.8x", + IF_DEBUG(_warn("%p moved from bucket %d:%p to %d:%p", sv, i, bucket_iter, index, new_bucket)); insert_in_bucket(new_bucket, sv); } @@ -268,7 +307,6 @@ } } } - return ins; } @@ -284,7 +322,7 @@ SV **el_iter, **el_last; if (!bucket_iter->sv) - continue; + continue; el_iter = bucket_iter->sv; el_last = el_iter + bucket_iter->n; @@ -293,7 +331,7 @@ { if (*el_iter) { - IF_DEBUG(_warn("freeing 0x%.8x, rc = %d, bucket = 0x%.8x(%d)) pos = %d", + IF_DEBUG(_warn("freeing %p, rc = %d, bucket = %p(%ld)) pos = %ld", *el_iter, SvREFCNT(*el_iter), bucket_iter, bucket_iter - s->bucket, el_iter - bucket_iter->sv)); @@ -324,14 +362,17 @@ MAGIC* _detect_magic(SV* sv) { + if (SvMAGICAL(sv)) return mg_find(sv, SET_OBJECT_MAGIC_backref); + else + return NULL; } void _dispel_magic(ISET* s, SV* sv) { SV* self_svrv = s->is_weak; MAGIC* mg = _detect_magic(sv); - IF_SPELL_DEBUG(_warn("dispelling magic from 0x%.8x (self = 0x%.8x, mg = 0x%.8x)", + IF_SPELL_DEBUG(_warn("dispelling magic from %p (self = %p, mg = %p)", sv, self_svrv, mg)); if (mg) { AV* wand = (void *)(mg->mg_obj); @@ -346,7 +387,7 @@ ISET* o = INT2PTR(ISET*, SvIV(svp[i])); if (s == o) { /* - SPELL_DEBUG("dropping RC of 0x%.8x from %d to %d", + SPELL_DEBUG("dropping RC of %p from %d to %d", svp[i], SvREFCNT(svp[i]), SvREFCNT(svp[i])-1); SvREFCNT_dec(svp[i]); */ @@ -358,23 +399,8 @@ i--; } if (!c) { - /* we should clear the magic, really. */ - MAGIC* last = 0; - for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { - if (mg->mg_type == SET_OBJECT_MAGIC_backref) { - if (last) { - last->mg_moremagic = mg->mg_moremagic; - Safefree(mg); - break; - } else if (mg->mg_moremagic) { - SvMAGIC(sv) = mg->mg_moremagic; - } else { - SvMAGIC(sv) = 0; - SvAMAGIC_off(sv); - } - } - last=mg; - } + sv_unmagic(sv, SET_OBJECT_MAGIC_backref); + SvREFCNT_dec(wand); } } } @@ -385,6 +411,7 @@ BUCKET* bucket_iter = s->bucket; BUCKET* bucket_last = bucket_iter + s->buckets; + THR_LOCK; for (; bucket_iter != bucket_last; ++bucket_iter) { SV **el_iter, **el_last; @@ -398,20 +425,25 @@ for (; el_iter != el_last; ++el_iter) if (*el_iter) { if (strong) { + THR_UNLOCK; _dispel_magic(s, *el_iter); SvREFCNT_inc(*el_iter); - IF_DEBUG(_warn("bumped RC of 0x%.8x to %d", *el_iter, + IF_DEBUG(_warn("bumped RC of %p to %d", *el_iter, SvREFCNT(*el_iter))); + THR_LOCK; } else { + THR_UNLOCK; if ( SvREFCNT(*el_iter) > 1 ) _cast_magic(s, *el_iter); SvREFCNT_dec(*el_iter); - IF_DEBUG(_warn("reduced RC of 0x%.8x to %d", *el_iter, + IF_DEBUG(_warn("reduced RC of %p to %d", *el_iter, SvREFCNT(*el_iter))); + THR_LOCK; } } } + THR_UNLOCK; } int @@ -421,25 +453,26 @@ SV ** const svp = AvARRAY(av); I32 i = AvFILLp(av); - IF_SPELL_DEBUG(_warn("_spell_effect (SV=0x%.8x, av_len=%d)", sv, + IF_SPELL_DEBUG(_warn("_spell_effect (SV=%p, av_len=%d)", sv, av_len(av))); while (i >= 0) { IF_SPELL_DEBUG(_warn("_spell_effect %d", i)); if (svp[i] && SvIOK(svp[i]) && SvIV(svp[i])) { ISET* s = INT2PTR(ISET*, SvIV(svp[i])); - IF_SPELL_DEBUG(_warn("_spell_effect i = %d, SV = 0x%.8x", i, svp[i])); + IF_SPELL_DEBUG(_warn("_spell_effect i = %d, SV = %p", i, svp[i])); if (!s->is_weak) Perl_croak(aTHX_ "panic: set_object_magic_killbackrefs (flags=%"UVxf")", (UV)SvFLAGS(svp[i])); /* SvREFCNT_dec(svp[i]); */ svp[i] = newSViv(0); if (iset_remove_one(s, sv, 1) != 1) { - _warn("Set::Object magic backref hook called on non-existent item (0x%x, self = 0x%x)", sv, s->is_weak); + _warn("Set::Object magic backref hook called on non-existent item (%p, self = %p)", sv, s->is_weak); }; } i--; } + return 0; } static MGVTBL SET_OBJECT_vtbl_backref = @@ -457,13 +490,13 @@ mg = _detect_magic(sv); if (mg) { - IF_SPELL_DEBUG(_warn("sv_magicext reusing wand 0x%.8x for 0x%.8x", wand, sv)); + IF_SPELL_DEBUG(_warn("sv_magicext reusing wand %p for %p", wand, sv)); wand = (AV *)mg->mg_obj; assert( SvTYPE(wand) == SVt_PVAV ); } else { wand=newAV(); - IF_SPELL_DEBUG(_warn("sv_magicext(0x%.8x, 0x%.8x, %ld, 0x%.8x, NULL, 0)", sv, wand, how, vtable)); + IF_SPELL_DEBUG(_warn("sv_magicext(%p, %p, %d, %p, NULL, 0)", sv, wand, how, vtable)); #if (PERL_VERSION > 7) || ( (PERL_VERSION == 7)&&( PERL_SUBVERSION > 2) ) mg = sv_magicext(sv, (SV *)wand, how, vtable, NULL, 0); #else @@ -493,10 +526,10 @@ } if (free == -1) { - IF_SPELL_DEBUG(_warn("casting self 0x%.8x with av_push", self_svrv, free)); + IF_SPELL_DEBUG(_warn("casting self %p with av_push to the end", self_svrv)); av_push(wand, self_svrv); } else { - IF_SPELL_DEBUG(_warn("casting self 0x%.8x to slot %d", self_svrv, free)); + IF_SPELL_DEBUG(_warn("casting self %p to slot %d", self_svrv, free)); svp[free] = self_svrv; } @@ -509,20 +542,20 @@ iset_remove_one(ISET* s, SV* el, int spell_in_progress) { SV *referant; - I32 hash, index; - SV **el_iter, **el_last, **el_out_iter; - BUCKET* bucket; + I32 hash, index; + SV **el_iter, **el_last, **el_out_iter; + BUCKET* bucket; - IF_DEBUG(_warn("removing scalar 0x%.8x from set 0x%.8x", el, s)); + IF_DEBUG(_warn("removing scalar %p from set %p", el, s)); /* note an object being destroyed is not SvOK */ if (!spell_in_progress && !SvOK(el)) return 0; if (SvOK(el) && !SvROK(el)) { - IF_DEBUG(_warn("scalar is not a ref (flags = 0x%.8x)", SvFLAGS(el))); - if (s->flat) { - IF_DEBUG(_warn("calling remove_scalar for 0x%.8x", el)); + IF_DEBUG(_warn("scalar is not a ref (flags = 0x%x)", SvFLAGS(el))); + if (s->flat && HvKEYS(s->flat)) { + IF_DEBUG(_warn("calling remove_scalar for %p", el)); if (iset_remove_scalar(s, el)) return 1; } @@ -543,33 +576,38 @@ el_iter = bucket->sv; el_out_iter = el_iter; el_last = el_iter + bucket->n; - IF_DEBUG(_warn("remove: el_last = 0x%.8x, el_iter = 0x%.8x", el_last, el_iter)); - - for (; el_iter != el_last; ++el_iter) - { - if (*el_iter == referant) - { - if (s->is_weak) { - if (!spell_in_progress) { - IF_SPELL_DEBUG(_warn("Removing ST(0x%.8x) magic", referant)); - _dispel_magic(s,referant); - } else { - IF_SPELL_DEBUG(_warn("Not removing ST(0x%.8x) magic (spell in progress)", referant)); + IF_DEBUG(_warn("remove: el_last = %p, el_iter = %p", el_last, el_iter)); - } - } else { - IF_SPELL_DEBUG(_warn("Not removing ST(0x%.8x) magic from Muggle", referant)); - SvREFCNT_dec(referant); - } - *el_iter = 0; - --s->elems; - return 1; - } - else - { - IF_SPELL_DEBUG(_warn("ST(0x%.8x) != 0x%.8x", referant, *el_iter)); + THR_LOCK; + for (; el_iter != el_last; ++el_iter) { + if (*el_iter == referant) { + if (s->is_weak) { + THR_UNLOCK; + if (!spell_in_progress) { + IF_SPELL_DEBUG(_warn("Removing ST(%p) magic", referant)); + _dispel_magic(s,referant); + } else { + IF_SPELL_DEBUG(_warn("Not removing ST(%p) magic (spell in progress)", referant)); } + THR_LOCK; + } else { + THR_UNLOCK; + IF_SPELL_DEBUG(_warn("Not removing ST(%p) magic from Muggle", referant)); + THR_LOCK; + SvREFCNT_dec(referant); + } + *el_iter = 0; + --s->elems; + THR_UNLOCK; + return 1; } + else { + THR_UNLOCK; + IF_SPELL_DEBUG(_warn("ST(%p) != %p", referant, *el_iter)); + THR_LOCK; + } + } + THR_UNLOCK; return 0; } @@ -584,35 +622,34 @@ PPCODE: { - SV* self; - ISET* s; - I32 item; - SV* isv; + SV* self; + ISET* s; + I32 item; + SV* isv; - New(0, s, 1, ISET); - s->elems = 0; - s->bucket = 0; - s->buckets = 0; - s->flat = 0; - s->is_weak = 0; - - isv = newSViv( PTR2IV(s) ); - sv_2mortal(isv); + New(0, s, 1, ISET); + s->elems = 0; + s->buckets = 0; + s->bucket = NULL; + s->flat = Nullhv; + s->is_weak = Nullsv; + + isv = newSViv( PTR2IV(s) ); + sv_2mortal(isv); - self = newRV_inc(isv); - sv_2mortal(self); + self = newRV_inc(isv); + sv_2mortal(self); - sv_bless(self, gv_stashsv(pkg, FALSE)); + sv_bless(self, gv_stashsv(pkg, FALSE)); - for (item = 1; item < items; ++item) - { - ISET_INSERT(s, ST(item)); - } + for (item = 1; item < items; ++item) { + ISET_INSERT(s, ST(item)); + } - IF_DEBUG(_warn("set!")); + IF_DEBUG(_warn("set!")); - PUSHs(self); - XSRETURN(1); + PUSHs(self); + XSRETURN(1); } void @@ -630,11 +667,10 @@ _warn("INSERTING SET UP OWN ARSE"); } if ISET_INSERT(s, ST(item)) - inserted++; - IF_DEBUG(_warn("inserting 0x%.8x 0x%.8x size = %d", ST(item), SvRV(ST(item)), s->elems)); + inserted++; + IF_DEBUG(_warn("inserting %p %p size = %d", ST(item), SvRV(ST(item)), s->elems)); } - XSRETURN_IV(inserted); void @@ -652,10 +688,8 @@ for (item = 1; item < items; ++item) { SV* el = ST(item); - removed += iset_remove_one(s, el, 0); } -remove_out: XSRETURN_IV(removed); int @@ -664,16 +698,13 @@ CODE: ISET* s = INT2PTR(ISET*, SvIV(SvRV(self))); - if (s->elems) XSRETURN_UNDEF; - if (s->flat) { if (HvKEYS(s->flat)) { XSRETURN_UNDEF; } } - RETVAL = 1; OUTPUT: RETVAL @@ -684,9 +715,7 @@ CODE: ISET* s = INT2PTR(ISET*, SvIV(SvRV(self))); - RETVAL = s->elems + (s->flat ? HvKEYS(s->flat) : 0); - OUTPUT: RETVAL @@ -695,8 +724,7 @@ SV* self; CODE: - - RETVAL = SvREFCNT(self); + RETVAL = SvREFCNT(self); OUTPUT: RETVAL @@ -749,7 +777,7 @@ index = hash & (s->buckets - 1); bucket = s->bucket + index; - IF_DEBUG(_warn("includes: looking for 0x%.8x in bucket %d:0x%.8x", + IF_DEBUG(_warn("includes: looking for %p in bucket %d:%p", rv, index, bucket)); if (!bucket->sv) @@ -823,7 +851,7 @@ iset_clear(s); if (s->flat) { hv_clear(s->flat); - IF_REMOVE_DEBUG(_warn("iset_clear(%x): cleared", s)); + IF_REMOVE_DEBUG(_warn("iset_clear(%p): cleared", s)); } void @@ -864,7 +892,7 @@ if (s->is_weak) XSRETURN_UNDEF; - IF_DEBUG(_warn("weakening set (0x%.8x)", SvRV(self))); + IF_DEBUG(_warn("weakening set (%p)", SvRV(self))); s->is_weak = SvRV(self); @@ -880,7 +908,7 @@ if (!s->is_weak) XSRETURN_UNDEF; - IF_DEBUG(_warn("strengthening set (0x%.8x)", SvRV(self))); + IF_DEBUG(_warn("strengthening set (%p)", SvRV(self))); _fiddle_strength(s, 1); @@ -943,8 +971,8 @@ if (! (mg = _detect_magic(SvRV(sv))) ) XSRETURN_UNDEF; - IF_SPELL_DEBUG(_warn("found magic on 0x%.8x - 0x%.8x", sv, mg)); - IF_SPELL_DEBUG(_warn("mg_obj = 0x%.8x", mg->mg_obj)); + IF_SPELL_DEBUG(_warn("found magic on %p - %p", sv, mg)); + IF_SPELL_DEBUG(_warn("mg_obj = %p", mg->mg_obj)); /*magic = newSV(0); SvRV(magic) = mg->mg_obj; @@ -1133,7 +1161,7 @@ s->elems = 0; s->bucket = 0; s->buckets = 0; - s->flat = 0; + s->flat = NULL; s->is_weak = 0; if (!SvROK(obj)) { @@ -1161,3 +1189,32 @@ PUSHs(obj); XSRETURN(1); } + +BOOT: +{ +#ifdef USE_ITHREADS + MY_CXT_INIT; + MY_CXT.s = NULL; + MUTEX_INIT(&iset_mutex); +#endif +} + +#ifdef USE_ITHREADS + +void +CLONE(...) +PROTOTYPE: DISABLE +PREINIT: + ISET *old_s; +PPCODE: + { + dMY_CXT; + old_s = MY_CXT.s; + } + { + MY_CXT_CLONE; + MY_CXT.s = old_s; + } + XSRETURN(0); + +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/README new/Set-Object-1.31/README --- old/Set-Object-1.28/README 2009-01-15 03:25:26.000000000 +0100 +++ new/Set-Object-1.31/README 2013-04-03 17:51:01.000000000 +0200 @@ -1,6 +1,8 @@ README for Set::Object ~~~~~~~~~~~~~~~~~~~~~~ -Set::Object provides for sets of Perl objects - scalars and references. +Set::Object provides efficient sets, +unordered collections of Perl objects without duplicates +for scalars and references. INSTALLATION diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/SIGNATURE new/Set-Object-1.31/SIGNATURE --- old/Set-Object-1.28/SIGNATURE 2010-07-22 08:19:46.000000000 +0200 +++ new/Set-Object-1.31/SIGNATURE 2013-05-13 22:34:23.000000000 +0200 @@ -1,5 +1,5 @@ This file contains message digests of all files listed in MANIFEST, -signed via the Module::Signature module, version 0.61. +signed via the Module::Signature module, version 0.70. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: @@ -14,18 +14,23 @@ -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 9083e3c7f3b247405b838cea67278b7684e36e8d Changes.pod -SHA1 816639c05c69373b63a93333c3e7e60a87866e56 MANIFEST -SHA1 c826cfdec5efc768c4a6eaec8d690b4f309c03d0 Makefile.PL -SHA1 8e8a877750f1f3fbdc5240a86246ff4399c1184f Object.xs -SHA1 5df26a8f141049c2a8c277417af071782808300b README -SHA1 b37bd889c05b351e0ad41238fed62590ac85db4b lib/Set/Object.pm +SHA1 863e6d5e8dec0d0266a0b29459f1b28b077c6196 Changes.pod +SHA1 5173cdc86baaa3e3d8c8473f07fc183b5a3734e4 MANIFEST +SHA1 dab450d5468b141d5b795a8c36d5506900aeb3d4 META.json +SHA1 6381aaef4591f397366ffe81a1a636dbdf757cdc META.yml +SHA1 709085a7da718ccba1917bf3b8378200e9932129 Makefile.PL +SHA1 a2761c62ceaf67fd1406c63bc486c9633245043f Object.xs +SHA1 5e98a7ceabf3a58e98e9414ae731a997c44319dc README +SHA1 46a84dbbe4808a29d145a7b398512a80778f9725 lib/Set/Object.pm SHA1 3ee3d2b72d4130ed27f8d24a2625fa22895e52ca lib/Set/Object/Weak.pm SHA1 f04d25338c1e35bda69ac5eda0bc672e10ca5b6f ppport.h SHA1 213b597a69c1f909d585a14a6a094a25c3e684af t/ingy/arrayref.t SHA1 db433f58da0fbecc971da5815ef5a530cd7f59f4 t/misc/leaks.t +SHA1 65ab384cd581403af529384551803e6268010d79 t/misc/more_leaks.t SHA1 4a159d3dccb6918ec790905d0e2bec3e58db15e9 t/misc/pod.t SHA1 dfb47bc536bc8bface7f95144e4985dd79447977 t/misc/pod_coverage.t +SHA1 cef10bf7c0f4611887c5e68113eac6c2339071d6 t/misc/segfault.t +SHA1 7812f8bc9b04bd0724a9c5dec3d0c52fceefe2df t/misc/threads.t SHA1 494c2f3a77ce211ffcbedc5e44dd8a6454764fe2 t/misc/undef.t SHA1 018c38db837777290619ec16a5f1c0dd5783263a t/object/Person.pm SHA1 40b4a7db1302cbd1d9b57e23508209818c8542dc t/object/Saint.pm @@ -46,7 +51,7 @@ SHA1 35a2ea64d0f939557f15c4e55f22715ebe5dafaf t/object/storable.t SHA1 479a9f5cd91b03a7ef37a833886c54e8e19c18cd t/object/subsuper.t SHA1 d18eaba2928ec2aa58a09feb70e49aad7d05e3f6 t/object/symmetric_difference.t -SHA1 f96b691a78eb18bc85739b6b0c4b45d2208b2669 t/object/union.t +SHA1 ee100a55511f208155e2ca071032e46383f2d102 t/object/union.t SHA1 eebb5dae0215a01ec427abafac502d534c20d524 t/object/weakref.t SHA1 85b0418c45937ccfc37694fc0463617d9d926261 t/scalar/basic.t SHA1 547133fca61d8af7abfd6774be681f65b48ca43e t/scalar/basic_overload.t @@ -60,15 +65,16 @@ SHA1 d00164943603bc6351f73b964d14db38cd66e29c t/scalar/intersection.t SHA1 e72984620f6382d997ec011f411e3da74607457b t/scalar/member.t SHA1 cf3478a70332d3267efe4b3692e03f83c5fa0f6f t/scalar/misc.t -SHA1 51dbd125f4572b1013193558347d8bf157e6e1b4 t/scalar/set_set.t -SHA1 ba9c5f6853edc466ef5c91b72e9747143126ffe4 t/scalar/storable.t +SHA1 8e56ff096b5eb7c70c380c92b69da26e1a18bba2 t/scalar/set_set.t +SHA1 61db09c832f4ec7145cc35e7c67fade79d4d78f0 t/scalar/storable.t SHA1 559cbb9d251852392ac9f74a4c6144e938ffbdae t/scalar/symmdiff.t SHA1 908f3fedbcff83d7ecca66c0b4ef99aa5bd69481 t/scalar/union.t SHA1 31d6d80a33dd2da72ab10b51bb272c24ad556f89 t/scalar/unique.t +SHA1 66dca8177780e09a12de4970c27820624ef46249 typemap -----BEGIN PGP SIGNATURE----- -Version: GnuPG v1.4.10 (GNU/Linux) +Version: GnuPG v1.4.12 (GNU/Linux) -iEYEARECAAYFAkxH4wAACgkQ/AZAiGayWEO7uQCfQ6rsTZDG4YkKd6qAiSC9xkDN -UGMAoKYJYoM5Chf0efBN6voo25H9yzXs -=YmFY +iEYEARECAAYFAlGRTkwACgkQmm2SYo/9yUKDsACgiqOhkBGAlADNh814vhxzkZch +OxUAn0iDcUEuaXz19saGEHXHUdBIlH9b +=K0EZ -----END PGP SIGNATURE----- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/lib/Set/Object.pm new/Set-Object-1.31/lib/Set/Object.pm --- old/Set-Object-1.28/lib/Set/Object.pm 2010-07-22 08:18:49.000000000 +0200 +++ new/Set-Object-1.31/lib/Set/Object.pm 2013-05-13 22:34:02.000000000 +0200 @@ -305,17 +305,23 @@ catered to by that module. Please use the versions in L<Scalar::Util> in preference to these -functions. +functions. In fact, if you use these functions in your production +code then you may have to rewrite it some day. They are retained only +because they are "mostly harmless". =over =item B<blessed> +B<Do not use in production code> + Returns a true value if the passed reference (RV) is blessed. See also L<Acme::Holy>. =item B<reftype> +B<Do not use in production code> + A bit like the perl built-in C<ref> function, but returns the I<type> of reference; ie, if the reference is blessed then it returns what C<ref> would have if it were not blessed. Useful for "seeing through" @@ -323,12 +329,16 @@ =item B<refaddr> +B<Do not use in production code> + Returns the memory address of a scalar. B<Warning>: this is I<not> guaranteed to be unique for scalars created in a program; memory might get re-used! =item B<is_int>, B<is_string>, B<is_double> +B<Do not use in production code> + A quick way of checking the three bits on scalars - IOK (is_int), NOK (is_double) and POK (is_string). Note that the exact behaviour of when these bits get set is not defined by the perl API. @@ -338,10 +348,14 @@ =item B<is_overloaded> +B<Do not use in production code> + A quick way to check if an object has overload magic on it. =item B<ish_int> +B<Deprecated and will be removed in 2014> + This function returns true, if the value it is passed looks like it I<already is> a representation of an I<integer>. This is so that you can decide whether the value passed is a hash key or an array @@ -349,18 +363,16 @@ =item B<is_key> -This function returns true, if the value it is passed looks more like -an I<index> to a collection than a I<value> of a collection. +B<Deprecated and will be removed in 2014> -But wait, you say - Set::Object has no indices, one of the fundamental -properties of a Set is that it is an I<unordered collection>. Which -means I<no indices>. Well, if this module were ever to be derived to -be a more general multi-purpose collection, then this (and C<ish_int>) -might be a good function to use to distinguish different types of -indexes from values. +This function returns true, if the value it is passed looks more like +an I<index> to a collection than a I<value> of a collection. Similar +to the looks_like_number internal function, but weird. Avoid. =item B<get_magic> +B<Do not use in production code> + Pass to a scalar, and get the magick wand (C<mg_obj>) used by the weak set implementation. The return will be a list of integers which are pointers to the actual C<ISET> structure. Whatever you do don't @@ -463,17 +475,18 @@ =head1 THREAD SAFETY -This module has none. +This module is not thread-safe. =head1 AUTHOR Original Set::Object module by Jean-Louis Leroy, <[email protected]> -Set::Scalar compatibility, XS debugging, weak references support and -general maintainership courtesy of Sam Vilain, <[email protected]>. -Maximum respect to those who send me test scripts, enhancements, etc -as patches against my git tree, browsable at -L<http://utsl.gen.nz/gitweb/?p=Set-Object>. +Set::Scalar compatibility, XS debugging, weak references support +courtesy of Sam Vilain, <[email protected]>. + +New maintainer is Reini Urban <[email protected]>. +Patches against L<https://github.com/rurban/Set-Object/> please. +Tickets at RT L<https://rt.cpan.org/Public/Dist/Display.html?Name=Set-Object> =head1 LICENCE @@ -486,6 +499,8 @@ Portions Copyright (c) 2006, 2007, Catalyst IT (NZ) Limited. Same license. +Portions Copyright (c) 2013, cPanel. Same license. + =head1 SEE ALSO perl(1), perltie(1), L<Set::Scalar>, overload.pm @@ -509,7 +524,7 @@ @EXPORT_OK = qw( ish_int is_int is_string is_double blessed reftype refaddr is_overloaded is_object is_key set weak_set ); -$VERSION = '1.28'; +$VERSION = '1.31'; bootstrap Set::Object $VERSION; @@ -934,7 +949,7 @@ return is_key(&$sub($_[0])); } elsif ($sub = UNIVERSAL::can($_[0], '(""')) { return is_key(&$sub($_[0])); - } elsif ($sub = UNIVERAL::can($_[0], '(nomethod')) { + } elsif ($sub = UNIVERSAL::can($_[0], '(nomethod')) { return is_key(&$sub($_[0])); } else { return undef; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/t/misc/more_leaks.t new/Set-Object-1.31/t/misc/more_leaks.t --- old/Set-Object-1.28/t/misc/more_leaks.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Set-Object-1.31/t/misc/more_leaks.t 2013-04-05 02:03:29.000000000 +0200 @@ -0,0 +1,54 @@ +use strict; +use warnings; +use Config; +use Test::More; + +BEGIN { + for (qw(Test::LeakTrace Moose)) { + eval "use $_"; + if ($@) { + plan 'skip_all' => "$_ missing"; + exit(0); + } + } +} + +use Set::Object; + +{ + package Foo; + use Moose; + 1; +} + +{ + no strict; + note join ' ', map {$Config{$_}} qw(osname archname); + note 'perl version ', $]; + note $_,'-',${"${_}::VERSION"} for qw{Moose Set::Object Test::LeakTrace}; +} + +my $set; +{ + $set = Set::Object->new; + no_leaks_ok { + { + my $obj = Foo->new; + $set->insert($obj); + $set->remove($obj); + } + } 'Testing Set::Object for leaking'; +} + +{ + $set = Set::Object::Weak->new; + no_leaks_ok { + { + my $obj = Foo->new; + $set->insert($obj); + $set->remove($obj); + } + } 'Testing Set::Object::Weak for leaking'; +} + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/t/misc/segfault.t new/Set-Object-1.31/t/misc/segfault.t --- old/Set-Object-1.28/t/misc/segfault.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Set-Object-1.31/t/misc/segfault.t 2013-04-03 16:39:08.000000000 +0200 @@ -0,0 +1,10 @@ + +use Test::More tests => 1; +use Set::Object qw(weak_set); + +my $n = 1; +my $a = \$n; +my $set1 = weak_set(); +$set1->insert($a); + +pass; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/t/misc/threads.t new/Set-Object-1.31/t/misc/threads.t --- old/Set-Object-1.28/t/misc/threads.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Set-Object-1.31/t/misc/threads.t 2013-04-05 02:03:29.000000000 +0200 @@ -0,0 +1,63 @@ +use strict; +use Test::More; +BEGIN { + eval 'use threads'; + if ($@) { + plan skip_all => 'threads missing'; + exit(0); + } +} +plan tests => 2; +use threads::shared; +use Set::Object; + +my $sh = new Set::Object(); +my $warnings; +share($sh); +#share($warnings); + +$SIG{__WARN__} = sub { $warnings = 1; warn @_ }; + +my $t1 = threads->new(\&f1); +my $t2 = threads->new(\&f2); + +main(); + +$t1->join; +$t2->join; +threads->yield; + +is $warnings, undef; + +while ($t1->is_running && $t2->is_running) { + sleep(0.1); +} + +TODO: { + local $TODO = "Set::Object has still refcount issues with threads RT#22760"; + is (scalar($sh->members), 5); +} + +sub f1{ + foreach my $i (1..100){ + my $d = $i % 10; + $sh->remove($d) if $sh->element($d); + } +} + +sub f2{ + foreach my $i (1..100){ + my $d = $i % 10; + $sh->remove($d); + #$sh->element($d); + } +} + +sub main{ + my $d; + foreach my $i (1..100){ + my $d = $i % 10; + $sh->insert($d); + } +} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/t/object/union.t new/Set-Object-1.31/t/object/union.t --- old/Set-Object-1.28/t/object/union.t 2008-10-12 22:54:02.000000000 +0200 +++ new/Set-Object-1.31/t/object/union.t 2013-04-03 18:41:24.000000000 +0200 @@ -1,25 +1,28 @@ +use strict; +use warnings; use Set::Object; - use Test::More tests => 10; +my (@simpsons, $homer, $marge, $bart, $lisa, $maggie, $patty, $selma); + require 't/object/Person.pm'; package Person; populate(); foreach my $class ( qw(Set::Object Set::Object::Weak) ) { - $simpsons = $class->new($homer, $marge); - $bouviers = $class->new($marge, $patty, $selma); - $both = $class->new($homer, $marge, $patty, $selma); - $empty = $class->new; + my $simpsons = $class->new($homer, $marge); + my $bouviers = $class->new($marge, $patty, $selma); + my $both = $class->new($homer, $marge, $patty, $selma); + my $empty = $class->new; - ::ok( $simpsons->union($bouviers) == $both, "union method" ); + ::ok( $simpsons->union($bouviers) == $both, "union method" ); - ::ok( $simpsons + $bouviers == $both, "op_union" ); + ::ok( $simpsons + $bouviers == $both, "op_union" ); - ::ok( $bouviers + $simpsons == $both, "op union with ops reversed" ); + ::ok( $bouviers + $simpsons == $both, "op union with ops reversed" ); - ::ok( $simpsons + $simpsons == $simpsons, "union with self" ); + ::ok( $simpsons + $simpsons == $simpsons, "union with self" ); - ::ok( $simpsons + $empty == $simpsons, "union with empty set" ); + ::ok( $simpsons + $empty == $simpsons, "union with empty set" ); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/t/scalar/set_set.t new/Set-Object-1.31/t/scalar/set_set.t --- old/Set-Object-1.28/t/scalar/set_set.t 2005-11-17 22:08:51.000000000 +0100 +++ new/Set-Object-1.31/t/scalar/set_set.t 2013-04-03 18:14:21.000000000 +0200 @@ -1,14 +1,12 @@ +use Test::More tests => 2; use Set::Object; -print "1..2\n"; - my $s = Set::Object->new("a"); my $t = Set::Object->new("b"); $s->insert($t); -print "not " unless $s eq "Set::Object(Set::Object(b) a)"; -print "ok 1\n"; +is($s, "Set::Object(Set::Object(b) a)"); $t->insert($s); @@ -43,6 +41,6 @@ #print "not " unless $s == "(a (b) (c ...))"; #print "ok 7\n"; # -print "not " unless $t eq "Set::Object(b)"; -print "ok 2\n"; + +is($t, "Set::Object(b)"); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/t/scalar/storable.t new/Set-Object-1.31/t/scalar/storable.t --- old/Set-Object-1.28/t/scalar/storable.t 2006-06-21 05:19:51.000000000 +0200 +++ new/Set-Object-1.31/t/scalar/storable.t 2013-04-03 18:19:22.000000000 +0200 @@ -29,14 +29,14 @@ my $returned = thaw($stored); #print "no segfault yet!\n"; #diag(Dumper($returned, $set)); -is_deeply([ sort { ref($a) cmp ref($b) } $returned->members ], - [ sort { ref($a) cmp ref($b) } $set->members ], +is_deeply([ sort $returned->members ], + [ sort $set->members ], "Set::Object serialises via Storable!"); isnt($$returned, $$set, "thaw returned a new Set::Object"); my $spawned = dclone($set); -is_deeply([ sort { ref($a) cmp ref($b) } $spawned->members ], - [ sort { ref($a) cmp ref($b) } $set->members ], +is_deeply([ sort $spawned->members ], + [ sort $set->members ], "Set::Object dclones via Storable!"); isnt($$spawned, $$set, "dclone returned a new Set::Object"); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Set-Object-1.28/typemap new/Set-Object-1.31/typemap --- old/Set-Object-1.28/typemap 1970-01-01 01:00:00.000000000 +0100 +++ new/Set-Object-1.31/typemap 2013-04-05 15:43:01.000000000 +0200 @@ -0,0 +1,2 @@ +# missing by 5.6 +const char * T_PV -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
