From f001cc46fcf48c9b4c09514d8eeb9c8d9eba6501 Mon Sep 17 00:00:00 2001 From: "Matthew Horsfall (alh)" Date: Thu, 8 May 2014 08:49:36 -0400 Subject: [PATCH] Revert "Upgrade Devel::PPPort from 3.21 to 3.22" This reverts commit 8e5dcc37de4ab79d8ec6f30798947ae97355ff2a, since the SvREFCNT_dec_NN is bad (leaks). --- Porting/Maintainers.pl | 2 +- cpan/Devel-PPPort/Makefile.PL | 15 --- cpan/Devel-PPPort/PPPort_pm.PL | 6 +- cpan/Devel-PPPort/parts/apicheck.pl | 1 - cpan/Devel-PPPort/parts/inc/SvREFCNT | 21 +-- cpan/Devel-PPPort/parts/inc/call | 3 - cpan/Devel-PPPort/parts/inc/magic | 243 +---------------------------------- cpan/Devel-PPPort/parts/inc/pv_tools | 4 +- cpan/Devel-PPPort/soak | 2 +- cpan/Devel-PPPort/t/SvREFCNT.t | 4 +- cpan/Devel-PPPort/t/magic.t | 28 +--- 11 files changed, 12 insertions(+), 317 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index df005a0..3e4e2eb 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -340,7 +340,7 @@ use File::Glob qw(:case); }, 'Devel::PPPort' => { - 'DISTRIBUTION' => 'WOLFSAGE/Devel-PPPort-3.22.tar.gz', + 'DISTRIBUTION' => 'MHX/Devel-PPPort-3.21.tar.gz', # RJBS has asked MHX to have UPSTREAM be 'blead' # (i.e. move this from cpan/ to dist/) 'FILES' => q[cpan/Devel-PPPort], diff --git a/cpan/Devel-PPPort/Makefile.PL b/cpan/Devel-PPPort/Makefile.PL index 25e352e..2353324 100644 --- a/cpan/Devel-PPPort/Makefile.PL +++ b/cpan/Devel-PPPort/Makefile.PL @@ -34,21 +34,6 @@ WriteMakefile( OBJECT => 'RealPPPort$(OBJ_EXT) $(O_FILES)', XSPROTOARG => '-noprototypes', CONFIGURE => \&configure, - META_MERGE => { - 'meta-spec' => { - version => 2, - }, - resources => { - bugtracker => { - web => 'https://github.com/mhx/Devel-PPPort/issues/', - }, - repository => { - type => 'git', - url => 'git://github.com/mhx/Devel-PPPort.git', - web => 'https://github.com/mhx/Devel-PPPort/', - }, - }, - }, ); sub configure diff --git a/cpan/Devel-PPPort/PPPort_pm.PL b/cpan/Devel-PPPort/PPPort_pm.PL index 4a30252..23ffb6b 100644 --- a/cpan/Devel-PPPort/PPPort_pm.PL +++ b/cpan/Devel-PPPort/PPPort_pm.PL @@ -499,10 +499,6 @@ Version 2.x was ported to the Perl core by Paul Marquess. Version 3.x was ported back to CPAN by Marcus Holland-Moritz. -=item * - -Versions >= 3.22 are maintained with support from Matthew Horsfall (alh). - =back =head1 COPYRIGHT @@ -527,7 +523,7 @@ package Devel::PPPort; use strict; use vars qw($VERSION $data); -$VERSION = '3.22'; +$VERSION = '3.21'; sub _init_data { diff --git a/cpan/Devel-PPPort/parts/apicheck.pl b/cpan/Devel-PPPort/parts/apicheck.pl index bea9bac..e11187f 100644 --- a/cpan/Devel-PPPort/parts/apicheck.pl +++ b/cpan/Devel-PPPort/parts/apicheck.pl @@ -146,7 +146,6 @@ print OUT < 1) SvREFCNT_dec(sv); mXPUSHi(SvREFCNT(sv) == 1); SvREFCNT_dec(sv); - XSRETURN(15); + XSRETURN(14); -=tests plan => 15 +=tests plan => 14 for (Devel::PPPort::SvREFCNT()) { ok(defined $_ and $_); diff --git a/cpan/Devel-PPPort/parts/inc/call b/cpan/Devel-PPPort/parts/inc/call index 7d8e4d3..6ccd9e7 100644 --- a/cpan/Devel-PPPort/parts/inc/call +++ b/cpan/Devel-PPPort/parts/inc/call @@ -124,9 +124,6 @@ vload_module(U32 flags, SV *name, SV *ver, va_list *args) #if { VERSION >= 5.004 } utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), veop, modname, imop); -#elif { VERSION > 5.003 } - utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), - veop, modname, imop); #else utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), modname, imop); diff --git a/cpan/Devel-PPPort/parts/inc/magic b/cpan/Devel-PPPort/parts/inc/magic index 6fe1ac8..59cd40b 100644 --- a/cpan/Devel-PPPort/parts/inc/magic +++ b/cpan/Devel-PPPort/parts/inc/magic @@ -11,34 +11,14 @@ =provides -mg_findext -sv_unmagicext - __UNDEFINED__ /sv_\w+_mg/ sv_magic_portable -MUTABLE_PTR -MUTABLE_SV =implementation __UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END -/* Some random bits for sv_unmagicext. These should probably be pulled in for - real and organized at some point */ - -__UNDEFINED__ HEf_SVKEY -2 - -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) -#else -# define MUTABLE_PTR(p) ((void *) (p)) -#endif - -#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) - -/* end of random bits */ - __UNDEFINED__ PERL_MAGIC_sv '\0' __UNDEFINED__ PERL_MAGIC_overload 'A' __UNDEFINED__ PERL_MAGIC_overload_elem 'a' @@ -220,205 +200,8 @@ __UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring #endif -#if !defined(mg_findext) -#if { NEED mg_findext } - -MAGIC * -mg_findext(pTHX_ SV * sv, int type, const MGVTBL *vtbl) { - if (sv) { - MAGIC *mg; - -#ifdef AvPAD_NAMELIST - assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv))); -#endif - - for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) { - if (mg->mg_type == type && mg->mg_virtual == vtbl) - return mg; - } - } - - return NULL; -} - -#endif -#endif - -#if !defined(sv_unmagicext) -#if { NEED sv_unmagicext } - -int -sv_unmagicext(pTHX_ SV *const sv, const int type, MGVTBL *vtbl) -{ - MAGIC* mg; - MAGIC** mgp; - - if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv)) - return 0; - mgp = &(SvMAGIC(sv)); - for (mg = *mgp; mg; mg = *mgp) { - const MGVTBL* const virt = mg->mg_virtual; - if (mg->mg_type == type && virt == vtbl) { - *mgp = mg->mg_moremagic; - if (virt && virt->svt_free) - virt->svt_free(aTHX_ sv, mg); - if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) { - if (mg->mg_len > 0) - Safefree(mg->mg_ptr); - else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */ - SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr)); - else if (mg->mg_type == PERL_MAGIC_utf8) - Safefree(mg->mg_ptr); - } - if (mg->mg_flags & MGf_REFCOUNTED) - SvREFCNT_dec(mg->mg_obj); - Safefree(mg); - } - else - mgp = &mg->mg_moremagic; - } - if (SvMAGIC(sv)) { - if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */ - mg_magical(sv); /* else fix the flags now */ - } - else { - SvMAGICAL_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; - } - return 0; -} - -#endif -#endif - -=xsinit - -#define NEED_mg_findext -#define NEED_sv_unmagicext - -#ifndef STATIC -#define STATIC static -#endif - -STATIC MGVTBL null_mg_vtbl = { - NULL, /* get */ - NULL, /* set */ - NULL, /* len */ - NULL, /* clear */ - NULL, /* free */ -#if MGf_COPY - NULL, /* copy */ -#endif /* MGf_COPY */ -#if MGf_DUP - NULL, /* dup */ -#endif /* MGf_DUP */ -#if MGf_LOCAL - NULL, /* local */ -#endif /* MGf_LOCAL */ -}; - -STATIC MGVTBL other_mg_vtbl = { - NULL, /* get */ - NULL, /* set */ - NULL, /* len */ - NULL, /* clear */ - NULL, /* free */ -#if MGf_COPY - NULL, /* copy */ -#endif /* MGf_COPY */ -#if MGf_DUP - NULL, /* dup */ -#endif /* MGf_DUP */ -#if MGf_LOCAL - NULL, /* local */ -#endif /* MGf_LOCAL */ -}; - =xsubs -SV * -new_with_other_mg(package, ...) - SV *package - PREINIT: - HV *self; - HV *stash; - SV *self_ref; - int i = 0; - const char *data = "hello\0"; - MAGIC *mg; - CODE: - self = newHV(); - stash = gv_stashpv(SvPV_nolen(package), 0); - - self_ref = newRV_noinc((SV*)self); - - sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data)); - mg = mg_find((SV*)self, PERL_MAGIC_ext); - mg->mg_virtual = &other_mg_vtbl; - - RETVAL = sv_bless(self_ref, stash); - OUTPUT: - RETVAL - -SV * -new_with_mg(package, ...) - SV *package - PREINIT: - HV *self; - HV *stash; - SV *self_ref; - int i = 0; - const char *data = "hello\0"; - MAGIC *mg; - CODE: - self = newHV(); - stash = gv_stashpv(SvPV_nolen(package), 0); - - self_ref = newRV_noinc((SV*)self); - - sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data)); - mg = mg_find((SV*)self, PERL_MAGIC_ext); - mg->mg_virtual = &null_mg_vtbl; - - RETVAL = sv_bless(self_ref, stash); - OUTPUT: - RETVAL - -void -remove_null_magic(self) - SV *self - PREINIT: - HV *obj; - PPCODE: - obj = (HV*) SvRV(self); - - sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl); - -void -remove_other_magic(self) - SV *self - PREINIT: - HV *obj; - PPCODE: - obj = (HV*) SvRV(self); - - sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &other_mg_vtbl); - -void -as_string(self) - SV *self - PREINIT: - HV *obj; - MAGIC *mg; - PPCODE: - obj = (HV*) SvRV(self); - - if (mg = mg_findext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl)) { - XPUSHs(sv_2mortal(newSVpv(mg->mg_ptr, strlen(mg->mg_ptr)))); - } else { - XPUSHs(sv_2mortal(newSVpvs("Sorry, your princess is in another castle."))); - } - void sv_catpv_mg(sv, string) SV *sv; @@ -531,31 +314,7 @@ sv_magic_portable(sv) OUTPUT: RETVAL -=tests plan => 23 - -# Find proper magic -ok(my $obj1 = Devel::PPPort->new_with_mg()); -ok(Devel::PPPort::as_string($obj1), 'hello'); - -# Find with no magic -my $obj = bless {}, 'Fake::Class'; -ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); - -# Find with other magic (not the magic we are looking for) -ok($obj = Devel::PPPort->new_with_other_mg()); -ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); - -# Okay, attempt to remove magic that isn't there -Devel::PPPort::remove_other_magic($obj1); -ok(Devel::PPPort::as_string($obj1), 'hello'); - -# Remove magic that IS there -Devel::PPPort::remove_null_magic($obj1); -ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); - -# Removing when no magic present -Devel::PPPort::remove_null_magic($obj1); -ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); +=tests plan => 15 use Tie::Hash; my %h; diff --git a/cpan/Devel-PPPort/parts/inc/pv_tools b/cpan/Devel-PPPort/parts/inc/pv_tools index 41a4907..a8a477f 100644 --- a/cpan/Devel-PPPort/parts/inc/pv_tools +++ b/cpan/Devel-PPPort/parts/inc/pv_tools @@ -80,10 +80,10 @@ pv_escape(pTHX_ SV *dsv, char const * const str, if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) { if (flags & PERL_PV_ESCAPE_FIRSTCHAR) chsize = my_snprintf(octbuf, sizeof octbuf, - "%" UVxf, u); + "%"UVxf, u); else chsize = my_snprintf(octbuf, sizeof octbuf, - "%cx{%" UVxf "}", esc, u); + "%cx{%"UVxf"}", esc, u); } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { chsize = 1; } else { diff --git a/cpan/Devel-PPPort/soak b/cpan/Devel-PPPort/soak index 522d6ea..da0dfae 100644 --- a/cpan/Devel-PPPort/soak +++ b/cpan/Devel-PPPort/soak @@ -27,7 +27,7 @@ use File::Find; use List::Util qw(max); use Config; -my $VERSION = '3.22'; +my $VERSION = '3.21'; $| = 1; my %OPT = ( diff --git a/cpan/Devel-PPPort/t/SvREFCNT.t b/cpan/Devel-PPPort/t/SvREFCNT.t index 7f228b0..0b46a51 100644 --- a/cpan/Devel-PPPort/t/SvREFCNT.t +++ b/cpan/Devel-PPPort/t/SvREFCNT.t @@ -30,9 +30,9 @@ BEGIN { require 'testutil.pl' if $@; } - if (15) { + if (14) { load(); - plan(tests => 15); + plan(tests => 14); } } diff --git a/cpan/Devel-PPPort/t/magic.t b/cpan/Devel-PPPort/t/magic.t index f467613..0bfe053 100644 --- a/cpan/Devel-PPPort/t/magic.t +++ b/cpan/Devel-PPPort/t/magic.t @@ -30,9 +30,9 @@ BEGIN { require 'testutil.pl' if $@; } - if (23) { + if (15) { load(); - plan(tests => 23); + plan(tests => 15); } } @@ -48,30 +48,6 @@ bootstrap Devel::PPPort; package main; -# Find proper magic -ok(my $obj1 = Devel::PPPort->new_with_mg()); -ok(Devel::PPPort::as_string($obj1), 'hello'); - -# Find with no magic -my $obj = bless {}, 'Fake::Class'; -ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); - -# Find with other magic (not the magic we are looking for) -ok($obj = Devel::PPPort->new_with_other_mg()); -ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); - -# Okay, attempt to remove magic that isn't there -Devel::PPPort::remove_other_magic($obj1); -ok(Devel::PPPort::as_string($obj1), 'hello'); - -# Remove magic that IS there -Devel::PPPort::remove_null_magic($obj1); -ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); - -# Removing when no magic present -Devel::PPPort::remove_null_magic($obj1); -ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); - use Tie::Hash; my %h; tie %h, 'Tie::StdHash'; -- 2.7.4