Skip to content

Commit f001cc4

Browse files
wolfsagewolfsage
committed
Revert "Upgrade Devel::PPPort from 3.21 to 3.22"
This reverts commit 8e5dcc3, since the SvREFCNT_dec_NN is bad (leaks).
1 parent 89c2544 commit f001cc4

File tree

11 files changed

+12
-317
lines changed

11 files changed

+12
-317
lines changed

‎Porting/Maintainers.pl

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -340,7 +340,7 @@ package Maintainers;
340340
},
341341

342342
'Devel::PPPort' => {
343-
'DISTRIBUTION' => 'WOLFSAGE/Devel-PPPort-3.22.tar.gz',
343+
'DISTRIBUTION' => 'MHX/Devel-PPPort-3.21.tar.gz',
344344
# RJBS has asked MHX to have UPSTREAM be 'blead'
345345
# (i.e. move this from cpan/ to dist/)
346346
'FILES' => q[cpan/Devel-PPPort],

‎cpan/Devel-PPPort/Makefile.PL

Lines changed: 0 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -34,21 +34,6 @@ WriteMakefile(
3434
OBJECT => 'RealPPPort$(OBJ_EXT) $(O_FILES)',
3535
XSPROTOARG => '-noprototypes',
3636
CONFIGURE => \&configure,
37-
META_MERGE => {
38-
'meta-spec' => {
39-
version => 2,
40-
},
41-
resources => {
42-
bugtracker => {
43-
web => 'https://github.com/mhx/Devel-PPPort/issues/',
44-
},
45-
repository => {
46-
type => 'git',
47-
url => 'git://github.com/mhx/Devel-PPPort.git',
48-
web => 'https://github.com/mhx/Devel-PPPort/',
49-
},
50-
},
51-
},
5237
);
5338

5439
sub configure

‎cpan/Devel-PPPort/PPPort_pm.PL

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -499,10 +499,6 @@ Version 2.x was ported to the Perl core by Paul Marquess.
499499
500500
Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
501501
502-
=item *
503-
504-
Versions >= 3.22 are maintained with support from Matthew Horsfall (alh).
505-
506502
=back
507503
508504
=head1 COPYRIGHT
@@ -527,7 +523,7 @@ package Devel::PPPort;
527523
use strict;
528524
use vars qw($VERSION $data);
529525
530-
$VERSION = '3.22';
526+
$VERSION = '3.21';
531527
532528
sub _init_data
533529
{

‎cpan/Devel-PPPort/parts/apicheck.pl

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -146,7 +146,6 @@
146146
#define NEED_load_module
147147
#define NEED_my_snprintf
148148
#define NEED_my_sprintf
149-
#define NEED_mg_findext
150149
#define NEED_my_strlcat
151150
#define NEED_my_strlcpy
152151
#define NEED_newCONSTSUB

‎cpan/Devel-PPPort/parts/inc/SvREFCNT

Lines changed: 2 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,6 @@ SvREFCNT_inc
1515
SvREFCNT_inc_simple
1616
SvREFCNT_inc_NN
1717
SvREFCNT_inc_void
18-
SvREFCNT_dec_NN
1918
__UNDEFINED__
2019

2120
=implementation
@@ -77,20 +76,6 @@ __UNDEFINED__
7776
# endif
7877
#endif
7978

80-
#ifndef SvREFCNT_dec_NN
81-
# ifdef PERL_USE_GCC_BRACE_GROUPS
82-
# define SvREFCNT_dec_NN(sv) \
83-
({ \
84-
SV * const _sv = (SV*)(sv); \
85-
SvREFCNT(_sv)--; \
86-
_sv; \
87-
})
88-
# else
89-
# define SvREFCNT_dec_NN(sv) \
90-
(PL_Sv=(SV*)(sv),--(SvREFCNT(PL_Sv)),PL_Sv)
91-
# endif
92-
#endif
93-
9479
__UNDEFINED__ SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
9580
__UNDEFINED__ SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
9681
__UNDEFINED__ SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
@@ -125,15 +110,13 @@ SvREFCNT()
125110
mXPUSHi(SvREFCNT(sv) == 8);
126111
SvREFCNT_inc_simple_void_NN(sv);
127112
mXPUSHi(SvREFCNT(sv) == 9);
128-
SvREFCNT_dec_NN(sv);
129-
mXPUSHi(SvREFCNT(sv) == 8);
130113
while (SvREFCNT(sv) > 1)
131114
SvREFCNT_dec(sv);
132115
mXPUSHi(SvREFCNT(sv) == 1);
133116
SvREFCNT_dec(sv);
134-
XSRETURN(15);
117+
XSRETURN(14);
135118

136-
=tests plan => 15
119+
=tests plan => 14
137120

138121
for (Devel::PPPort::SvREFCNT()) {
139122
ok(defined $_ and $_);

‎cpan/Devel-PPPort/parts/inc/call

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -124,9 +124,6 @@ vload_module(U32 flags, SV *name, SV *ver, va_list *args)
124124
#if { VERSION >= 5.004 }
125125
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
126126
veop, modname, imop);
127-
#elif { VERSION > 5.003 }
128-
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
129-
veop, modname, imop);
130127
#else
131128
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
132129
modname, imop);

‎cpan/Devel-PPPort/parts/inc/magic

Lines changed: 1 addition & 242 deletions
Original file line numberDiff line numberDiff line change
@@ -11,34 +11,14 @@
1111

1212
=provides
1313

14-
mg_findext
15-
sv_unmagicext
16-
1714
__UNDEFINED__
1815
/sv_\w+_mg/
1916
sv_magic_portable
20-
MUTABLE_PTR
21-
MUTABLE_SV
2217

2318
=implementation
2419

2520
__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
2621

27-
/* Some random bits for sv_unmagicext. These should probably be pulled in for
28-
real and organized at some point */
29-
30-
__UNDEFINED__ HEf_SVKEY -2
31-
32-
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
33-
# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
34-
#else
35-
# define MUTABLE_PTR(p) ((void *) (p))
36-
#endif
37-
38-
#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
39-
40-
/* end of random bits */
41-
4222
__UNDEFINED__ PERL_MAGIC_sv '\0'
4323
__UNDEFINED__ PERL_MAGIC_overload 'A'
4424
__UNDEFINED__ PERL_MAGIC_overload_elem 'a'
@@ -220,205 +200,8 @@ __UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring
220200

221201
#endif
222202

223-
#if !defined(mg_findext)
224-
#if { NEED mg_findext }
225-
226-
MAGIC *
227-
mg_findext(pTHX_ SV * sv, int type, const MGVTBL *vtbl) {
228-
if (sv) {
229-
MAGIC *mg;
230-
231-
#ifdef AvPAD_NAMELIST
232-
assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
233-
#endif
234-
235-
for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
236-
if (mg->mg_type == type && mg->mg_virtual == vtbl)
237-
return mg;
238-
}
239-
}
240-
241-
return NULL;
242-
}
243-
244-
#endif
245-
#endif
246-
247-
#if !defined(sv_unmagicext)
248-
#if { NEED sv_unmagicext }
249-
250-
int
251-
sv_unmagicext(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
252-
{
253-
MAGIC* mg;
254-
MAGIC** mgp;
255-
256-
if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
257-
return 0;
258-
mgp = &(SvMAGIC(sv));
259-
for (mg = *mgp; mg; mg = *mgp) {
260-
const MGVTBL* const virt = mg->mg_virtual;
261-
if (mg->mg_type == type && virt == vtbl) {
262-
*mgp = mg->mg_moremagic;
263-
if (virt && virt->svt_free)
264-
virt->svt_free(aTHX_ sv, mg);
265-
if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
266-
if (mg->mg_len > 0)
267-
Safefree(mg->mg_ptr);
268-
else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
269-
SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
270-
else if (mg->mg_type == PERL_MAGIC_utf8)
271-
Safefree(mg->mg_ptr);
272-
}
273-
if (mg->mg_flags & MGf_REFCOUNTED)
274-
SvREFCNT_dec(mg->mg_obj);
275-
Safefree(mg);
276-
}
277-
else
278-
mgp = &mg->mg_moremagic;
279-
}
280-
if (SvMAGIC(sv)) {
281-
if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
282-
mg_magical(sv); /* else fix the flags now */
283-
}
284-
else {
285-
SvMAGICAL_off(sv);
286-
SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
287-
}
288-
return 0;
289-
}
290-
291-
#endif
292-
#endif
293-
294-
=xsinit
295-
296-
#define NEED_mg_findext
297-
#define NEED_sv_unmagicext
298-
299-
#ifndef STATIC
300-
#define STATIC static
301-
#endif
302-
303-
STATIC MGVTBL null_mg_vtbl = {
304-
NULL, /* get */
305-
NULL, /* set */
306-
NULL, /* len */
307-
NULL, /* clear */
308-
NULL, /* free */
309-
#if MGf_COPY
310-
NULL, /* copy */
311-
#endif /* MGf_COPY */
312-
#if MGf_DUP
313-
NULL, /* dup */
314-
#endif /* MGf_DUP */
315-
#if MGf_LOCAL
316-
NULL, /* local */
317-
#endif /* MGf_LOCAL */
318-
};
319-
320-
STATIC MGVTBL other_mg_vtbl = {
321-
NULL, /* get */
322-
NULL, /* set */
323-
NULL, /* len */
324-
NULL, /* clear */
325-
NULL, /* free */
326-
#if MGf_COPY
327-
NULL, /* copy */
328-
#endif /* MGf_COPY */
329-
#if MGf_DUP
330-
NULL, /* dup */
331-
#endif /* MGf_DUP */
332-
#if MGf_LOCAL
333-
NULL, /* local */
334-
#endif /* MGf_LOCAL */
335-
};
336-
337203
=xsubs
338204

339-
SV *
340-
new_with_other_mg(package, ...)
341-
SV *package
342-
PREINIT:
343-
HV *self;
344-
HV *stash;
345-
SV *self_ref;
346-
int i = 0;
347-
const char *data = "hello\0";
348-
MAGIC *mg;
349-
CODE:
350-
self = newHV();
351-
stash = gv_stashpv(SvPV_nolen(package), 0);
352-
353-
self_ref = newRV_noinc((SV*)self);
354-
355-
sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data));
356-
mg = mg_find((SV*)self, PERL_MAGIC_ext);
357-
mg->mg_virtual = &other_mg_vtbl;
358-
359-
RETVAL = sv_bless(self_ref, stash);
360-
OUTPUT:
361-
RETVAL
362-
363-
SV *
364-
new_with_mg(package, ...)
365-
SV *package
366-
PREINIT:
367-
HV *self;
368-
HV *stash;
369-
SV *self_ref;
370-
int i = 0;
371-
const char *data = "hello\0";
372-
MAGIC *mg;
373-
CODE:
374-
self = newHV();
375-
stash = gv_stashpv(SvPV_nolen(package), 0);
376-
377-
self_ref = newRV_noinc((SV*)self);
378-
379-
sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data));
380-
mg = mg_find((SV*)self, PERL_MAGIC_ext);
381-
mg->mg_virtual = &null_mg_vtbl;
382-
383-
RETVAL = sv_bless(self_ref, stash);
384-
OUTPUT:
385-
RETVAL
386-
387-
void
388-
remove_null_magic(self)
389-
SV *self
390-
PREINIT:
391-
HV *obj;
392-
PPCODE:
393-
obj = (HV*) SvRV(self);
394-
395-
sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl);
396-
397-
void
398-
remove_other_magic(self)
399-
SV *self
400-
PREINIT:
401-
HV *obj;
402-
PPCODE:
403-
obj = (HV*) SvRV(self);
404-
405-
sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &other_mg_vtbl);
406-
407-
void
408-
as_string(self)
409-
SV *self
410-
PREINIT:
411-
HV *obj;
412-
MAGIC *mg;
413-
PPCODE:
414-
obj = (HV*) SvRV(self);
415-
416-
if (mg = mg_findext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl)) {
417-
XPUSHs(sv_2mortal(newSVpv(mg->mg_ptr, strlen(mg->mg_ptr))));
418-
} else {
419-
XPUSHs(sv_2mortal(newSVpvs("Sorry, your princess is in another castle.")));
420-
}
421-
422205
void
423206
sv_catpv_mg(sv, string)
424207
SV *sv;
@@ -531,31 +314,7 @@ sv_magic_portable(sv)
531314
OUTPUT:
532315
RETVAL
533316

534-
=tests plan => 23
535-
536-
# Find proper magic
537-
ok(my $obj1 = Devel::PPPort->new_with_mg());
538-
ok(Devel::PPPort::as_string($obj1), 'hello');
539-
540-
# Find with no magic
541-
my $obj = bless {}, 'Fake::Class';
542-
ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
543-
544-
# Find with other magic (not the magic we are looking for)
545-
ok($obj = Devel::PPPort->new_with_other_mg());
546-
ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
547-
548-
# Okay, attempt to remove magic that isn't there
549-
Devel::PPPort::remove_other_magic($obj1);
550-
ok(Devel::PPPort::as_string($obj1), 'hello');
551-
552-
# Remove magic that IS there
553-
Devel::PPPort::remove_null_magic($obj1);
554-
ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
555-
556-
# Removing when no magic present
557-
Devel::PPPort::remove_null_magic($obj1);
558-
ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
317+
=tests plan => 15
559318

560319
use Tie::Hash;
561320
my %h;

0 commit comments

Comments
 (0)