Change 27659 by [EMAIL PROTECTED] on 2006/04/01 14:31:37
Propagate cop_hints inside string evals. For the unthreaded case this
is easy. For the threaded case it's not, because the current OP may
be shared with another thread, so solve this by copying the hints
chain.
Affected files ...
... //depot/perl/embed.fnc#343 edit
... //depot/perl/embed.h#578 edit
... //depot/perl/hv.c#298 edit
... //depot/perl/pod/perlintern.pod#50 edit
... //depot/perl/pp_ctl.c#538 edit
... //depot/perl/proto.h#690 edit
... //depot/perl/t/op/caller.t#8 edit
Differences ...
==== //depot/perl/embed.fnc#343 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#342~27657~ 2006-04-01 04:32:23.000000000 -0800
+++ perl/embed.fnc 2006-04-01 06:31:37.000000000 -0800
@@ -303,6 +303,8 @@
Ap |void |hv_ksplit |NN HV* hv|IV newmax
Apdbm |void |hv_magic |NN HV* hv|NULLOK GV* gv|int how
#ifdef USE_ITHREADS
+dpoM|struct refcounted_he *|refcounted_he_copy \
+ |NULLOK const struct refcounted_he *he
dpoM|struct refcounted_he *|refcounted_he_dup \
|NULLOK const struct refcounted_he *const he \
|NN CLONE_PARAMS* param
==== //depot/perl/hv.c#298 (text) ====
Index: perl/hv.c
--- perl/hv.c#297~27643~ 2006-03-31 05:45:57.000000000 -0800
+++ perl/hv.c 2006-04-01 06:31:37.000000000 -0800
@@ -2695,6 +2695,39 @@
copy->refcounted_he_refcnt = he->refcounted_he_refcnt;
return copy;
}
+
+/*
+=for apidoc refcounted_he_copy
+
+Copies a chain of C<struct refcounted_he *>. Used by C<pp_entereval>.
+
+=cut
+*/
+
+struct refcounted_he *
+Perl_refcounted_he_copy(pTHX_ const struct refcounted_he * he)
+{
+ struct refcounted_he *copy;
+ HEK *hek;
+ /* This is much easier to express recursively than iteratively. */
+ if (!he)
+ return NULL;
+
+ Newx(copy, 1, struct refcounted_he);
+ copy->refcounted_he_he.hent_next
+ = (HE *)Perl_refcounted_he_copy(aTHX_
+ (struct refcounted_he *)
+ he->refcounted_he_he.hent_next);
+ copy->refcounted_he_he.he_valu.hent_val
+ = newSVsv(he->refcounted_he_he.he_valu.hent_val);
+ hek = he->refcounted_he_he.hent_hek;
+ copy->refcounted_he_he.hent_hek
+ = share_hek(HEK_KEY(hek),
+ HEK_UTF8(hek) ? -(I32)HEK_LEN(hek) : HEK_LEN(hek),
+ HEK_HASH(hek));
+ copy->refcounted_he_refcnt = 1;
+ return copy;
+}
#endif
/*
==== //depot/perl/pod/perlintern.pod#50 (text+w) ====
Index: perl/pod/perlintern.pod
--- perl/pod/perlintern.pod#49~27643~ 2006-03-31 05:45:57.000000000 -0800
+++ perl/pod/perlintern.pod 2006-04-01 06:31:37.000000000 -0800
@@ -485,6 +485,16 @@
=for hackers
Found in file hv.c
+=item refcounted_he_copy
+X<refcounted_he_copy>
+
+Copies a chain of C<struct refcounted_he *>. Used by C<pp_entereval>.
+
+ struct refcounted_he * refcounted_he_copy(const struct refcounted_he
*he)
+
+=for hackers
+Found in file hv.c
+
=item refcounted_he_dup
X<refcounted_he_dup>
@@ -515,7 +525,7 @@
the property of the caller. The C<struct refcounted_he> is returned with a
reference count of 1.
- struct refcounted_he * refcounted_he_new(struct refcounted_he *parent,
SV *key, SV *value)
+ struct refcounted_he * refcounted_he_new(struct refcounted_he *const
parent, SV *key, SV *value)
=for hackers
Found in file hv.c
==== //depot/perl/pp_ctl.c#538 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#537~27643~ 2006-03-31 05:45:57.000000000 -0800
+++ perl/pp_ctl.c 2006-04-01 06:31:37.000000000 -0800
@@ -3476,6 +3476,29 @@
PL_compiling.cop_io = newSVsv(PL_curcop->cop_io);
SAVEFREESV(PL_compiling.cop_io);
}
+ if (PL_compiling.cop_hints) {
+ PL_compiling.cop_hints->refcounted_he_refcnt--;
+ }
+ PL_compiling.cop_hints = PL_curcop->cop_hints;
+ if (PL_compiling.cop_hints) {
+#ifdef USE_ITHREADS
+ /* PL_curcop could be pointing to an optree owned by another /.*parent/
+ thread. We can't manipulate the reference count of the refcounted he
+ there (race condition) so we have to do something less than
+ pleasant to keep it read only. The simplest solution seems to be to
+ copy their chain. We might want to cache this.
+ Alternatively we could add a flag to the refcounted he *we* point to
+ here saying "I don't own a reference count on the thing I point to",
+ and arrange for Perl_refcounted_he_free() to spot that. If so, we'd
+ still need to copy the topmost refcounted he so that we could change
+ its flag. So still not trivial. (Flag bits could be hung from the
+ shared HEK) */
+ PL_compiling.cop_hints
+ = Perl_refcounted_he_copy(aTHX_ PL_compiling.cop_hints);
+#else
+ PL_compiling.cop_hints->refcounted_he_refcnt++;
+#endif
+ }
/* special case: an eval '' executed within the DB package gets lexically
* placed in the first non-DB CV rather than the current CV - this
* allows the debugger to execute code, find lexicals etc, in the
==== //depot/perl/proto.h#690 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#689~27657~ 2006-04-01 04:32:23.000000000 -0800
+++ perl/proto.h 2006-04-01 06:31:37.000000000 -0800
@@ -721,6 +721,7 @@
__attribute__nonnull__(pTHX_1); */
#ifdef USE_ITHREADS
+PERL_CALLCONV struct refcounted_he * Perl_refcounted_he_copy(pTHX_ const
struct refcounted_he *he);
PERL_CALLCONV struct refcounted_he * Perl_refcounted_he_dup(pTHX_ const
struct refcounted_he *const he, CLONE_PARAMS* param)
__attribute__nonnull__(pTHX_2);
==== //depot/perl/t/op/caller.t#8 (text) ====
Index: perl/t/op/caller.t
--- perl/t/op/caller.t#7~27646~ 2006-03-31 08:19:38.000000000 -0800
+++ perl/t/op/caller.t 2006-04-01 06:31:37.000000000 -0800
@@ -5,7 +5,7 @@
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
- plan( tests => 56 );
+ plan( tests => 64 );
}
my @c;
@@ -201,3 +201,27 @@
is(get_dooot(), 6 * 7);
is(get_thikoosh(), "SKREECH");
}
+
+print "# which now works inside evals\n";
+
+{
+ BEGIN {
+ $^H{dooot} = 42;
+ }
+ is(get_dooot(), 6 * 7);
+
+ eval "is(get_dooot(), 6 * 7); 1" or die $@;
+
+ eval <<'EOE' or die $@;
+ is(get_dooot(), 6 * 7);
+ eval "is(get_dooot(), 6 * 7); 1" or die $@;
+ BEGIN {
+ $^H{dooot} = 54;
+ }
+ is(get_dooot(), 54);
+ eval "is(get_dooot(), 54); 1" or die $@;
+ eval 'BEGIN { $^H{dooot} = -1; }; 1' or die $@;
+ is(get_dooot(), 54);
+ eval "is(get_dooot(), 54); 1" or die $@;
+EOE
+}
End of Patch.
