Change 18229 by merijn@merijn-l1 on 2002/12/02 15:43:16
$0 mofifying part I
Date: Sat, 30 Nov 2002 20:16:51 +0200
From: Jarkko Hietaniemi <[EMAIL PROTECTED]>
Subject: [PATCH] $0 modifying
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/ext/threads/t/join.t#2 edit
.... //depot/perl/makedef.pl#138 edit
.... //depot/perl/mg.c#243 edit
.... //depot/perl/perl.c#459 edit
.... //depot/perl/pod/perlvar.pod#109 edit
.... //depot/perl/sv.c#602 edit
.... //depot/perl/t/op/magic.t#55 edit
.... //depot/perl/thread.h#86 edit
Differences ...
==== //depot/perl/ext/threads/t/join.t#2 (text) ====
Index: perl/ext/threads/t/join.t
--- perl/ext/threads/t/join.t#1~14659~ Tue Feb 12 06:38:21 2002
+++ perl/ext/threads/t/join.t Mon Dec 2 07:43:16 2002
@@ -11,7 +11,7 @@
use ExtUtils::testlib;
use strict;
-BEGIN { print "1..10\n" };
+BEGIN { print "1..11\n" };
use threads;
use threads::shared;
@@ -86,4 +86,31 @@
return $foo{bar} = \$foo;
})->join();
ok(1,"");
+}
+
+if ($^O eq 'linux') { # We parse ps output so this is OS-dependent.
+
+ # First modify $0 in a subthread.
+ print "# 1a: \$0 = $0\n";
+ join( threads->new( sub {
+ print "# 2a: \$0 = $0\n";
+ $0 = "foobar";
+ print "# 2b: \$0 = $0\n" } ) );
+ print "# 1b: \$0 = $0\n";
+ if (open PS, "ps -f |") {
+ my $ok;
+ while (<PS>) {
+ print "# $_";
+ if (/^\S+\s+$$\s.+\sfoobar\s*$/) {
+ $ok++;
+ last;
+ }
+ }
+ close PS;
+ ok($ok, 'altering $0 is effective');
+ } else {
+ skip("\$0 check: opening 'ps -f |' failed: $!");
+ }
+} else {
+ skip("\$0 check: only on Linux");
}
==== //depot/perl/makedef.pl#138 (text) ====
Index: perl/makedef.pl
--- perl/makedef.pl#137~18030~ Sat Oct 19 07:10:21 2002
+++ perl/makedef.pl Mon Dec 2 07:43:16 2002
@@ -643,6 +643,7 @@
PL_regex_padav
PL_sharedsv_space
PL_sharedsv_space_mutex
+ PL_dollarzero_mutex
Perl_dirp_dup
Perl_cx_dup
Perl_si_dup
==== //depot/perl/mg.c#243 (text) ====
Index: perl/mg.c
--- perl/mg.c#242~18058~ Thu Oct 24 16:36:48 2002
+++ perl/mg.c Mon Dec 2 07:43:16 2002
@@ -2207,6 +2207,7 @@
break;
#ifndef MACOS_TRADITIONAL
case '0':
+ LOCK_DOLLARZERO_MUTEX;
#ifdef HAS_SETPROCTITLE
/* The BSDs don't show the argv[] in ps(1) output, they
* show a string from the process struct and provide
@@ -2286,6 +2287,7 @@
for (i = 1; i < PL_origargc; i++)
PL_origargv[i] = Nullch;
}
+ UNLOCK_DOLLARZERO_MUTEX;
break;
#endif
}
==== //depot/perl/perl.c#459 (text) ====
Index: perl/perl.c
--- perl/perl.c#458~18150~ Sat Nov 16 12:25:57 2002
+++ perl/perl.c Mon Dec 2 07:43:16 2002
@@ -489,11 +489,6 @@
PL_e_script = Nullsv;
}
- while (--PL_origargc >= 0) {
- Safefree(PL_origargv[PL_origargc]);
- }
- Safefree(PL_origargv);
-
/* magical thingies */
SvREFCNT_dec(PL_ofs_sv); /* $, */
@@ -897,21 +892,7 @@
#endif
PL_origargc = argc;
- {
- /* we copy rather than point to argv
- * since perl_clone will copy and perl_destruct
- * has no way of knowing if we've made a copy or
- * just point to argv
- */
- int i = PL_origargc;
- New(0, PL_origargv, i+1, char*);
- PL_origargv[i] = '\0';
- while (i-- > 0) {
- PL_origargv[i] = savepv(argv[i]);
- }
- }
-
-
+ PL_origargv = argv;
if (PL_do_undump) {
@@ -936,6 +917,10 @@
time(&PL_basetime);
oldscope = PL_scopestack_ix;
PL_dowarn = G_WARN_OFF;
+
+#ifdef USE_ITHREADS
+ MUTEX_INIT(&PL_dollarzero_mutex);
+#endif
#ifdef PERL_FLEXIBLE_EXCEPTIONS
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vparse_body), env, xsinit);
==== //depot/perl/pod/perlvar.pod#109 (text) ====
Index: perl/pod/perlvar.pod
--- perl/pod/perlvar.pod#108~17821~ Fri Aug 30 12:56:53 2002
+++ perl/pod/perlvar.pod Mon Dec 2 07:43:16 2002
@@ -869,6 +869,10 @@
result in C<"perl: foobar (perl)">. This is an operating system
feature.
+In multithreaded scripts Perl coordinates the threads so that any
+thread may modify its copy of the C<$0> and the change becomes visible
+to ps(1) (assuming the operating system plays along).
+
=item $[
The index of the first element in an array, and of the first character
==== //depot/perl/sv.c#602 (text) ====
Index: perl/sv.c
--- perl/sv.c#601~18220~ Sun Dec 1 16:58:54 2002
+++ perl/sv.c Mon Dec 2 07:43:16 2002
@@ -10233,12 +10233,7 @@
/* pseudo environmental stuff */
PL_origargc = proto_perl->Iorigargc;
- i = PL_origargc;
- New(0, PL_origargv, i+1, char*);
- PL_origargv[i] = '\0';
- while (i-- > 0) {
- PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
- }
+ PL_origargv = proto_perl->Iorigargv;
param->stashes = newAV(); /* Setup array of objects to call clone on */
==== //depot/perl/t/op/magic.t#55 (xtext) ====
Index: perl/t/op/magic.t
--- perl/t/op/magic.t#54~18171~ Fri Nov 22 13:15:54 2002
+++ perl/t/op/magic.t Mon Dec 2 07:43:16 2002
@@ -257,7 +257,7 @@
open CMDLINE, "/proc/$$/cmdline") {
chomp(my $line = scalar <CMDLINE>);
my $me = (split /\0/, $line)[0];
- ok($me eq $0, 'altering $0 is effective', 'PL_origarg{c,v} copy breaks
this');
+ ok($me eq $0, 'altering $0 is effective');
close CMDLINE;
} else {
skip("\$0 check only on Linux and FreeBSD with /proc");
==== //depot/perl/thread.h#86 (text) ====
Index: perl/thread.h
--- perl/thread.h#85~18030~ Sat Oct 19 07:10:21 2002
+++ perl/thread.h Mon Dec 2 07:43:16 2002
@@ -326,6 +326,9 @@
# define THREAD_RET_CAST(p) ((void *)(p))
#endif /* THREAD_RET */
+# define LOCK_DOLLARZERO_MUTEX MUTEX_LOCK(&PL_dollarzero_mutex)
+# define UNLOCK_DOLLARZERO_MUTEX MUTEX_UNLOCK(&PL_dollarzero_mutex)
+
#endif /* USE_ITHREADS */
#ifndef MUTEX_LOCK
@@ -402,6 +405,14 @@
#ifndef UNLOCK_SV_LOCK_MUTEX
# define UNLOCK_SV_LOCK_MUTEX
+#endif
+
+#ifndef LOCK_DOLLARZERO_MUTEX
+# define LOCK_DOLLARZERO_MUTEX
+#endif
+
+#ifndef UNLOCK_DOLLARZERO_MUTEX
+# define UNLOCK_DOLLARZERO_MUTEX
#endif
/* THR, SET_THR, and dTHR are there for compatibility with old versions */
End of Patch.
