@@ -1,5 +1,25 @@
Revision history for autovivification
+0.13 2014-10-04 16:55 UTC
+ This release contains a change that, while being very likely to be safe,
+ can potentially cause freezes during code compilation. Every release
+ should be carefully tested before being put in production, but this is
+ especially true for this one.
+ + Add : Support for the PERL_OP_PARENT optional feature introduced in
+ perl 5.21.2.
+ + Doc : The CAVEATS section now warns about the global slowdown during
+ compilation caused by this pragma.
+ + Fix : [RT #97703] : Android support
+ t/51-threads-teardown.t will no longer fail on Android.
+ Thanks Brian Fraser for reporting.
+ + Fix : Segfaults in eval in an END block of a Win32 pseudo-fork.
+ + Fix : Segfaults during global destruction of a thread or a
+ pseudo-fork.
+ + Opt : The global slowdown caused by this module has been greatly
+ reduced.
+ Thanks Ævar Arnfjörð Bjarmason for reporting and testing the
+ change.
+
0.12 2013-09-05 17:20 UTC
+ Fix : Check functions are now replaced and restored in a thread-safe
manner, either by using the wrap_op_checker() function from perl
@@ -7,7 +7,6 @@ README
autovivification.xs
lib/autovivification.pm
ptable.h
-reap.h
samples/bench.pl
samples/hash2array.pl
t/00-load.t
@@ -4,7 +4,7 @@
"Vincent Pit <perl@profvince.com>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.74, CPAN::Meta::Converter version 2.132140",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690",
"license" : [
"perl_5"
],
@@ -54,5 +54,5 @@
"url" : "http://git.profvince.com/?p=perl%2Fmodules%2Fautovivification.git"
}
},
- "version" : "0.12"
+ "version" : "0.13"
}
@@ -3,30 +3,30 @@ abstract: 'Lexically disable autovivification.'
author:
- 'Vincent Pit <perl@profvince.com>'
build_requires:
- Config: 0
- Exporter: 0
- ExtUtils::MakeMaker: 0
- Test::More: 0
- XSLoader: 0
+ Config: '0'
+ Exporter: '0'
+ ExtUtils::MakeMaker: '0'
+ Test::More: '0'
+ XSLoader: '0'
configure_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.74, CPAN::Meta::Converter version 2.132140'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: autovivification
no_index:
directory:
- t
- inc
requires:
- XSLoader: 0
- perl: 5.008003
+ XSLoader: '0'
+ perl: '5.008003'
resources:
bugtracker: http://rt.cpan.org/Dist/Display.html?Name=autovivification
homepage: http://search.cpan.org/dist/autovivification/
license: http://dev.perl.org/licenses/
repository: http://git.profvince.com/?p=perl%2Fmodules%2Fautovivification.git
-version: 0.12
+version: '0.13'
@@ -97,3 +97,12 @@ WriteMakefile(
},
%macro,
);
+
+package MY;
+
+sub postamble {
+ return <<'POSTAMBLE';
+testdeb: all
+ PERL_DL_NONLAZY=1 PERLDB_OPTS="NonStop=1" $(FULLPERLRUN) -MTAP::Harness -e 'TAP::Harness->new({verbosity => q{$(VERBOSE)}, lib => [ q{$(INST_LIB)}, q{$(INST_ARCHLIB)} ], switches => [ q{-d} ]})->runtests(@ARGV)' $(TEST_FILES)
+POSTAMBLE
+}
@@ -2,7 +2,7 @@ NAME
autovivification - Lexically disable autovivification.
VERSION
- Version 0.12
+ Version 0.13
SYNOPSIS
no autovivification;
@@ -138,6 +138,11 @@ CONSTANTS
where it is false for perl 5.10.0 and below.
CAVEATS
+ Using this pragma will cause a slight global slowdown of any subsequent
+ compilation phase that happens anywere in your code - even outside of
+ the scope of use of "no autovivification" - which may become noticeable
+ if you rely heavily on numerous calls to "eval STRING".
+
The pragma doesn't apply when one dereferences the returned value of an
array or hash slice, as in "@array[$id]->{member}" or
@hash{$key}->{member}. This syntax is valid Perl, yet it is discouraged
@@ -145,6 +150,10 @@ CAVEATS
context. If warnings are turned on, Perl will complain about one-element
slices.
+ Autovivifications that happen in code "eval"'d during the global
+ destruction phase of a spawned thread or pseudo-fork (the processes used
+ internally for the "fork" emulation on Windows) are not reported.
+
DEPENDENCIES
perl 5.8.3.
@@ -180,7 +189,8 @@ ACKNOWLEDGEMENTS
Matt S. Trout asked for it.
COPYRIGHT & LICENSE
- Copyright 2009,2010,2011,2012,2013 Vincent Pit, all rights reserved.
+ Copyright 2009,2010,2011,2012,2013,2014 Vincent Pit, all rights
+ reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -29,6 +29,10 @@
# define A_HAS_RPEEP A_HAS_PERL(5, 13, 5)
#endif
+#ifndef OP_SIBLING
+# define OP_SIBLING(O) ((O)->op_sibling)
+#endif
+
/* ... Thread safety and multiplicity ...................................... */
/* Always safe when the workaround isn't needed */
@@ -210,17 +214,40 @@ STATIC void a_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
#endif /* A_WORKAROUND_REQUIRE_PROPAGATION */
-#include "reap.h"
-
STATIC void a_thread_cleanup(pTHX_ void *ud) {
dMY_CXT;
#if A_WORKAROUND_REQUIRE_PROPAGATION
ptable_hints_free(MY_CXT.tbl);
+ MY_CXT.tbl = NULL;
#endif /* A_WORKAROUND_REQUIRE_PROPAGATION */
ptable_seen_free(MY_CXT.seen);
+ MY_CXT.seen = NULL;
+}
+
+STATIC int a_endav_free(pTHX_ SV *sv, MAGIC *mg) {
+ SAVEDESTRUCTOR_X(a_thread_cleanup, NULL);
+
+ return 0;
}
+STATIC MGVTBL a_endav_vtbl = {
+ 0,
+ 0,
+ 0,
+ 0,
+ a_endav_free
+#if MGf_COPY
+ , 0
+#endif
+#if MGf_DUP
+ , 0
+#endif
+#if MGf_LOCAL
+ , 0
+#endif
+};
+
#endif /* A_THREADSAFE */
#if A_WORKAROUND_REQUIRE_PROPAGATION
@@ -272,19 +299,22 @@ get_enclosing_cv:
STATIC SV *a_tag(pTHX_ UV bits) {
#define a_tag(B) a_tag(aTHX_ (B))
a_hint_t *h;
+#if A_THREADSAFE
+ dMY_CXT;
+
+ if (!MY_CXT.tbl)
+ return newSViv(0);
+#endif /* A_THREADSAFE */
h = PerlMemShared_malloc(sizeof *h);
h->bits = bits;
h->require_tag = a_require_tag();
#if A_THREADSAFE
- {
- dMY_CXT;
- /* We only need for the key to be an unique tag for looking up the value later
- * Allocated memory provides convenient unique identifiers, so that's why we
- * use the hint as the key itself. */
- ptable_hints_store(MY_CXT.tbl, h, h);
- }
+ /* We only need for the key to be an unique tag for looking up the value later
+ * Allocated memory provides convenient unique identifiers, so that's why we
+ * use the hint as the key itself. */
+ ptable_hints_store(MY_CXT.tbl, h, h);
#endif /* A_THREADSAFE */
return newSViv(PTR2IV(h));
@@ -293,16 +323,19 @@ STATIC SV *a_tag(pTHX_ UV bits) {
STATIC UV a_detag(pTHX_ const SV *hint) {
#define a_detag(H) a_detag(aTHX_ (H))
a_hint_t *h;
+#if A_THREADSAFE
+ dMY_CXT;
+
+ if (!MY_CXT.tbl)
+ return 0;
+#endif /* A_THREADSAFE */
if (!(hint && SvIOK(hint)))
return 0;
h = INT2PTR(a_hint_t *, SvIVX(hint));
#if A_THREADSAFE
- {
- dMY_CXT;
- h = ptable_fetch(MY_CXT.tbl, h);
- }
+ h = ptable_fetch(MY_CXT.tbl, h);
#endif /* A_THREADSAFE */
if (a_require_tag() != h->require_tag)
@@ -900,7 +933,7 @@ STATIC OP *a_ck_xslice(pTHX_ OP *o) {
case OP_HSLICE:
old_ck = a_old_ck_hslice;
if (hint & A_HINT_DO)
- a_recheck_rv2xv(cUNOPo->op_first->op_sibling, OP_RV2HV, a_pp_rv2hv);
+ a_recheck_rv2xv(OP_SIBLING(cUNOPo->op_first), OP_RV2HV, a_pp_rv2hv);
break;
}
o = old_ck(aTHX_ o);
@@ -980,11 +1013,22 @@ STATIC void a_peep_rec(pTHX_ OP *o, ptable *seen) {
const a_op_info *oi = NULL;
UV flags = 0;
+#if !A_HAS_RPEEP
if (ptable_fetch(seen, o))
break;
ptable_seen_store(seen, o, o);
+#endif
switch (o->op_type) {
+#if A_HAS_RPEEP
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
+ case OP_STUB:
+ if (ptable_fetch(seen, o))
+ return;
+ ptable_seen_store(seen, o, o);
+ break;
+#endif
case OP_PADSV:
if (o->op_ppaddr != a_pp_deref) {
oi = a_map_fetch(o);
@@ -1073,9 +1117,11 @@ STATIC void a_peep(pTHX_ OP *o) {
a_old_peep(aTHX_ o);
- ptable_seen_clear(seen);
- a_peep_rec(o);
- ptable_seen_clear(seen);
+ if (seen) {
+ ptable_seen_clear(seen);
+ a_peep_rec(o);
+ ptable_seen_clear(seen);
+ }
}
/* --- Interpreter setup/teardown ------------------------------------------ */
@@ -1096,8 +1142,10 @@ STATIC void a_teardown(pTHX_ void *root) {
dMY_CXT;
# if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
ptable_hints_free(MY_CXT.tbl);
+ MY_CXT.tbl = NULL;
# endif /* A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION */
ptable_seen_free(MY_CXT.seen);
+ MY_CXT.seen = NULL;
}
a_ck_restore(OP_PADANY, &a_old_ck_padany);
@@ -1222,10 +1270,11 @@ PREINIT:
ptable *t;
#endif
ptable *s;
+ GV *gv;
PPCODE:
{
- dMY_CXT;
#if A_WORKAROUND_REQUIRE_PROPAGATION
+ dMY_CXT;
{
a_ptable_clone_ud ud;
@@ -1245,7 +1294,23 @@ PPCODE:
#endif
MY_CXT.seen = s;
}
- reap(3, a_thread_cleanup, NULL);
+ gv = gv_fetchpv(__PACKAGE__ "::_THREAD_CLEANUP", 0, SVt_PVCV);
+ if (gv) {
+ CV *cv = GvCV(gv);
+ if (!PL_endav)
+ PL_endav = newAV();
+ SvREFCNT_inc(cv);
+ if (!av_store(PL_endav, av_len(PL_endav) + 1, (SV *) cv))
+ SvREFCNT_dec(cv);
+ sv_magicext((SV *) PL_endav, NULL, PERL_MAGIC_ext, &a_endav_vtbl, NULL, 0);
+ }
+ XSRETURN(0);
+
+void
+_THREAD_CLEANUP(...)
+PROTOTYPE: DISABLE
+PPCODE:
+ a_thread_cleanup(aTHX_ NULL);
XSRETURN(0);
#endif /* A_THREADSAFE */
@@ -11,13 +11,13 @@ autovivification - Lexically disable autovivification.
=head1 VERSION
-Version 0.12
+Version 0.13
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.12';
+ $VERSION = '0.13';
}
=head1 SYNOPSIS
@@ -200,10 +200,14 @@ This constant will always be true, except on Windows where it is false for perl
=head1 CAVEATS
+Using this pragma will cause a slight global slowdown of any subsequent compilation phase that happens anywere in your code - even outside of the scope of use of C<no autovivification> - which may become noticeable if you rely heavily on numerous calls to C<eval STRING>.
+
The pragma doesn't apply when one dereferences the returned value of an array or hash slice, as in C<< @array[$id]->{member} >> or C<< @hash{$key}->{member} >>.
This syntax is valid Perl, yet it is discouraged as the slice is here useless since the dereferencing enforces scalar context.
If warnings are turned on, Perl will complain about one-element slices.
+Autovivifications that happen in code C<eval>'d during the global destruction phase of a spawned thread or pseudo-fork (the processes used internally for the C<fork> emulation on Windows) are not reported.
+
=head1 DEPENDENCIES
L<perl> 5.8.3.
@@ -242,7 +246,7 @@ Matt S. Trout asked for it.
=head1 COPYRIGHT & LICENSE
-Copyright 2009,2010,2011,2012,2013 Vincent Pit, all rights reserved.
+Copyright 2009,2010,2011,2012,2013,2014 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
@@ -1,81 +0,0 @@
-/* This file is part of the autovivification Perl module.
- * See http://search.cpan.org/dist/autovivification/ */
-
-/* This header provides a specialized version of Scope::Upper::reap that can be
- * called directly from XS.
- * See http://search.cpan.org/dist/Scope-Upper/ for details. */
-
-#ifndef REAP_H
-#define REAP_H 1
-
-#define REAP_DESTRUCTOR_SIZE 3
-
-typedef struct {
- I32 depth;
- I32 *origin;
- void (*cb)(pTHX_ void *);
- void *ud;
- char *dummy;
-} reap_ud;
-
-STATIC void reap_pop(pTHX_ void *);
-
-STATIC void reap_pop(pTHX_ void *ud_) {
- reap_ud *ud = ud_;
- I32 depth, *origin, mark, base;
-
- depth = ud->depth;
- origin = ud->origin;
- mark = origin[depth];
- base = origin[depth - 1];
-
- if (base < mark) {
- PL_savestack_ix = mark;
- leave_scope(base);
- }
- PL_savestack_ix = base;
-
- if ((ud->depth = --depth) > 0) {
- SAVEDESTRUCTOR_X(reap_pop, ud);
- } else {
- void (*cb)(pTHX_ void *) = ud->cb;
- void *cb_ud = ud->ud;
-
- PerlMemShared_free(ud->origin);
- PerlMemShared_free(ud);
-
- SAVEDESTRUCTOR_X(cb, cb_ud);
- }
-}
-
-STATIC void reap(pTHX_ I32 depth, void (*cb)(pTHX_ void *), void *cb_ud) {
-#define reap(D, CB, UD) reap(aTHX_ (D), (CB), (UD))
- reap_ud *ud;
- I32 i;
-
- if (depth > PL_scopestack_ix)
- depth = PL_scopestack_ix;
-
- ud = PerlMemShared_malloc(sizeof *ud);
- ud->depth = depth;
- ud->origin = PerlMemShared_malloc((depth + 1) * sizeof *ud->origin);
- ud->cb = cb;
- ud->ud = cb_ud;
- ud->dummy = NULL;
-
- for (i = depth; i >= 1; --i) {
- I32 j = PL_scopestack_ix - i;
- ud->origin[depth - i] = PL_scopestack[j];
- PL_scopestack[j] += REAP_DESTRUCTOR_SIZE;
- }
- ud->origin[depth] = PL_savestack_ix;
-
- while (PL_savestack_ix + REAP_DESTRUCTOR_SIZE
- <= PL_scopestack[PL_scopestack_ix - 1]) {
- save_pptr(&ud->dummy);
- }
-
- SAVEDESTRUCTOR_X(reap_pop, ud);
-}
-
-#endif /* REAP_H */
@@ -4,20 +4,10 @@ use strict;
use warnings;
use lib 't/lib';
+use VPIT::TestHelpers;
use autovivification::TestThreads;
-use Test::Leaner tests => 1;
-
-sub run_perl {
- my $code = shift;
-
- my ($SystemRoot, $PATH) = @ENV{qw<SystemRoot PATH>};
- local %ENV;
- $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
- $ENV{PATH} = $PATH if $^O eq 'cygwin' and defined $PATH;
-
- system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
-}
+use Test::Leaner tests => 2;
SKIP:
{
@@ -37,3 +27,21 @@ SKIP:
RUN
is $status, 0, 'loading the pragma in a thread and using it outside doesn\'t segfault';
}
+
+{
+ my $status = run_perl <<' RUN';
+ use threads;
+ BEGIN { require autovivification; }
+ sub X::DESTROY {
+ eval 'no autovivification; my $x; my $y = $x->{foo}{bar}; use autovivification; my $z = $x->{a}{b}{c};';
+ exit 1 if $@;
+ }
+ threads->create(sub {
+ my $x = bless { }, 'X';
+ $x->{self} = $x;
+ return;
+ })->join;
+ exit $code;
+ RUN
+ is $status, 0, 'autovivification can be loaded in eval STRING during global destruction at the end of a thread';
+}
@@ -3,9 +3,12 @@ package VPIT::TestHelpers;
use strict;
use warnings;
+use Config ();
+
my %exports = (
load_or_skip => \&load_or_skip,
load_or_skip_all => \&load_or_skip_all,
+ run_perl => \&run_perl,
skip_all => \&skip_all,
);
@@ -102,6 +105,21 @@ sub load_or_skip_all {
return $loaded;
}
+sub run_perl {
+ my $code = shift;
+
+ my ($SystemRoot, $PATH) = @ENV{qw<SystemRoot PATH>};
+ my $ld_name = $Config::Config{ldlibpthname};
+ my $ldlibpth = $ENV{$ld_name};
+
+ local %ENV;
+ $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
+ $ENV{PATH} = $PATH if $^O eq 'cygwin' and defined $PATH;
+ $ENV{$ld_name} = $ldlibpth if $^O eq 'android' and defined $ldlibpth;
+
+ system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
+}
+
package VPIT::TestHelpers::Guard;
sub new {