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 - coolo@suse.com
+
+- 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, check SvMAGICAL before doing C
+ Fixed wrong C format types in warnings and C.
+ Added PREREQ_PMs, make LTest::LeakTrace and L<Moose> an optional dependency
+ for F
+- 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
+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, check SvMAGICAL before doing C
+
+=item *
+
+Fixed wrong C format types in warnings and C.
+Added PREREQ_PMs, make LTest::LeakTrace and L<Moose> an optional dependency
+for F
+
+=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 or C 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 LScalar::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 LAcme::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, B, B
+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
+B<Do not use in production code>
+
A quick way to check if an object has overload magic on it.
=item B
+B
+
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
-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
-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)
-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
+B<Do not use in production code>
+
Pass to a scalar, and get the magick wand (C) 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,
-Set::Scalar compatibility, XS debugging, weak references support and
-general maintainership courtesy of Sam Vilain, .
-Maximum respect to those who send me test scripts, enhancements, etc
-as patches against my git tree, browsable at
-Lhttp://utsl.gen.nz/gitweb/?p=Set-Object.
+Set::Scalar compatibility, XS debugging, weak references support
+courtesy of Sam Vilain, .
+
+New maintainer is Reini Urban .
+Patches against Lhttps://github.com/rurban/Set-Object/ please.
+Tickets at RT Lhttps://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), LSet::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: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org