This commit makes $$ writable again, as it was in 5.6, while preserv-
ing the magical pid-fetching added recently (post-5.14.0) by com-
mit
0e219455.
It does this by following Aristotle Pagaltzis’ brilliant suggestion in
<
20110609145148.GD8471@klangraum.plasmasturm.org>; namely, to store
the PID in magic when $$ is written to, so that get-magic can detect
whether a fork() has occurred and reset $$ accordingly. This makes it
seem as though the fork() code sets $$ itself (which it used to before
0e219455), while even working when C code outside of perl’s control
calls fork().
This restores compatibility with DBIx::Connector and PPerl.
#endif
goto magicalize;
- case '$': /* $$ */
- SvREADONLY_on(GvSVn(gv));
- goto magicalize;
case '!': /* $! */
GvMULTI_on(gv);
/* If %! has been used, automatically load Errno.pm. */
case '>': /* $> */
case '\\': /* $\ */
case '/': /* $/ */
+ case '$': /* $$ */
case '\001': /* $^A */
case '\003': /* $^C */
case '\004': /* $^D */
sv_copypv(sv, PL_ors_sv);
break;
case '$': /* $$ */
- sv_setiv(sv, (IV)PerlProc_getpid());
+ {
+ IV const pid = (IV)PerlProc_getpid();
+ if (isGV(mg->mg_obj) || SvIV(mg->mg_obj) != pid)
+ /* never set manually, or at least not since last fork */
+ sv_setiv(sv, pid);
+ /* else a value has been assigned manually, so do nothing */
+ }
break;
case '!':
case ':':
PL_chopset = SvPV_force(sv,len);
break;
+ case '$': /* $$ */
+ /* Store the pid in mg->mg_obj so we can tell when a fork has
+ occurred. mg->mg_obj points to *$ by default, so clear it. */
+ if (isGV(mg->mg_obj)) {
+ if (mg->mg_flags & MGf_REFCOUNTED) /* probably never true */
+ SvREFCNT_dec(mg->mg_obj);
+ mg->mg_flags |= MGf_REFCOUNTED;
+ mg->mg_obj = newSViv((IV)PerlProc_getpid());
+ }
+ else sv_setiv(mg->mg_obj, (IV)PerlProc_getpid());
+ break;
case '0':
LOCK_DOLLARZERO_MUTEX;
#ifdef HAS_SETPROCTITLE
The C<CORE::> prefix can now be used on keywords enabled by
L<feature.pm|feature>, even outside the scope of C<use feature>.
+=head2 C<$$> can be assigned to
+
+C<$$> was made read-only in Perl 5.8.0. But only sometimes: C<local $$>
+would make it writable again. Some CPAN modules were using C<local $$> or
+XS code to bypass the read-only check, so there is no reason to keep C<$$>
+read-only. (This change also allowed a bug to be fixed while maintaining
+backward compatibility.)
+
=head1 Security
XXX Any security-related notices go here. In particular, any security
[ List each incompatible change as a =head2 entry ]
-=head2 C<$$> no longer caches PID
-
-Previously, if one embeds Perl or uses XS and calls fork(3) from C, Perls
-notion of C<$$> could go out of sync with what getpid() returns. By always
-fetching the value of C<$$> via getpid(), this potential bug is eliminated.
-Code that depends on the caching behavior will break.
-
=head1 Deprecations
XXX Any deprecated features, syntax, modules etc. should be listed here.
=item *
+Previously, if one embeds Perl or uses XS and calls fork(3) from C, Perl's
+notion of C<$$> could go out of sync with what getpid() returns. By always
+fetching the value of C<$$> via getpid(), this potential bug is eliminated.
+
+=item *
+
Passing the same constant subroutine to both C<index> and C<formline> no
longer causes one or the other to fail [RT #89218].
use warnings;
use Config;
-plan (tests => 87);
+plan (tests => 88);
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_NetWare = $^O eq 'NetWare';
is $@, "foo\n";
cmp_ok($$, '>', 0);
-eval { $$++ };
-like ($@, qr/^Modification of a read-only value attempted/);
+eval { $$ = 42 };
+is $$, 42, '$$ can be modified';
+SKIP: {
+ skip "no fork", 1 unless $Config{d_fork};
+ (my $kidpid = open my $fh, "-|") // skip "cannot fork: $!", 1;
+ if($kidpid) { # parent
+ my $kiddollars = <$fh>;
+ close $fh or die "cannot close pipe from kid proc: $!";
+ is $kiddollars, $kidpid, '$$ is reset on fork';
+ }
+ else { # child
+ print $$;
+ $::NO_ENDING = 1; # silence "Looks like you only ran..."
+ exit;
+ }
+}
# $^X and $0
{