Change 30071 by [EMAIL PROTECTED] on 2007/01/29 22:30:00
Integrate:
[ 29361]
Fix for bug #38631: tied variables don't work with .= <>
[ 29416]
Subject: [perl #41008] Setting $0 invalidates environment shown by ps
From: [EMAIL PROTECTED] (via RT) <[EMAIL PROTECTED]>
Date: Tue, 28 Nov 2006 05:09:31 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 29446]
Subject: Re: [perl #38868] Changing $0 on darwin leads to excessive
padding in 'ps'
From: Chris Dolan <[EMAIL PROTECTED]>
Date: Sat, 2 Dec 2006 09:37:08 -0600
Message-Id: <[EMAIL PROTECTED]>
[ 29488]
add missing OP_REFCNT_LOCK/UNLOCKs and document it
[ 29530]
The overly-picky AIX xlc compiler doesn't like the style
from patch #29446
[ 29531]
Subject: [PATCH] mg.c: #ifdef only the different bits
From: [EMAIL PROTECTED] (Jarkko Hietaniemi)
Date: Tue, 12 Dec 2006 15:18:53 +0200 (EET)
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/maint-5.8/perl/mg.c#143 integrate
... //depot/maint-5.8/perl/op.h#33 integrate
... //depot/maint-5.8/perl/pp_hot.c#126 integrate
... //depot/maint-5.8/perl/sv.c#335 integrate
... //depot/maint-5.8/perl/t/op/readline.t#6 integrate
Differences ...
==== //depot/maint-5.8/perl/mg.c#143 (text) ====
Index: perl/mg.c
--- perl/mg.c#142~30066~ 2007-01-29 11:07:36.000000000 -0800
+++ perl/mg.c 2007-01-29 14:30:00.000000000 -0800
@@ -2621,15 +2621,14 @@
setproctitle("%s", s);
# endif
}
-#endif
-#if defined(__hpux) && defined(PSTAT_SETCMD)
+#elif defined(__hpux) && defined(PSTAT_SETCMD)
if (PL_origalen != 1) {
union pstun un;
s = SvPV_const(sv, len);
un.pst_command = (char *)s;
pstat(PSTAT_SETCMD, un, len, 0, 0);
}
-#endif
+#else
if (PL_origalen > 1) {
/* PL_origalen is set in perl_parse(). */
s = SvPV_force(sv,len);
@@ -2640,20 +2639,26 @@
}
else {
/* Shorter than original, will be padded. */
+#ifdef PERL_DARWIN
+ /* Special case for Mac OS X: see [perl #38868] */
+ const int pad = 0;
+#else
+ /* Is the space counterintuitive? Yes.
+ * (You were expecting \0?)
+ * Does it work? Seems to. (In Linux 2.4.20 at least.)
+ * --jhi */
+ const int pad = ' ';
+#endif
Copy(s, PL_origargv[0], len, char);
PL_origargv[0][len] = 0;
memset(PL_origargv[0] + len + 1,
- /* Is the space counterintuitive? Yes.
- * (You were expecting \0?)
- * Does it work? Seems to. (In Linux 2.4.20 at least.)
- * --jhi */
- (int)' ',
- PL_origalen - len - 1);
+ pad, PL_origalen - len - 1);
}
PL_origargv[0][PL_origalen-1] = 0;
for (i = 1; i < PL_origargc; i++)
PL_origargv[i] = 0;
}
+#endif
UNLOCK_DOLLARZERO_MUTEX;
break;
#endif
==== //depot/maint-5.8/perl/op.h#33 (text) ====
Index: perl/op.h
--- perl/op.h#32~30036~ 2007-01-27 09:35:47.000000000 -0800
+++ perl/op.h 2007-01-29 14:30:00.000000000 -0800
@@ -483,6 +483,15 @@
#define OA_SCALARREF 7
#define OA_OPTIONAL 8
+/* Op_REFCNT is a reference count at the head of each op tree: needed
+ * since the tree is shared between threads, and between cloned closure
+ * copies in the same thread. OP_REFCNT_LOCK/UNLOCK is used when modifying
+ * this count.
+ * The same mutex is used to protect the refcounts of the reg_trie_data
+ * and reg_ac_data structures, which are shared between duplicated
+ * regexes.
+ */
+
#ifdef USE_ITHREADS
# define OP_REFCNT_INIT MUTEX_INIT(&PL_op_mutex)
# ifdef PERL_CORE
==== //depot/maint-5.8/perl/pp_hot.c#126 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#125~30070~ 2007-01-29 14:12:03.000000000 -0800
+++ perl/pp_hot.c 2007-01-29 14:30:00.000000000 -0800
@@ -1621,6 +1621,8 @@
have_fp:
if (gimme == G_SCALAR) {
sv = TARG;
+ if (type == OP_RCATLINE && SvGMAGICAL(sv))
+ mg_get(sv);
if (SvROK(sv)) {
if (type == OP_RCATLINE)
SvPV_force_nolen(sv);
==== //depot/maint-5.8/perl/sv.c#335 (text) ====
Index: perl/sv.c
--- perl/sv.c#334~30069~ 2007-01-29 13:05:26.000000000 -0800
+++ perl/sv.c 2007-01-29 14:30:00.000000000 -0800
@@ -10002,7 +10002,9 @@
case OP_LEAVEWRITE:
TOPPTR(nss,ix) = ptr;
o = (OP*)ptr;
+ OP_REFCNT_LOCK;
OpREFCNT_inc(o);
+ OP_REFCNT_UNLOCK;
break;
default:
TOPPTR(nss,ix) = NULL;
@@ -10577,7 +10579,9 @@
/* current interpreter roots */
PL_main_cv = cv_dup_inc(proto_perl->Imain_cv, param);
+ OP_REFCNT_LOCK;
PL_main_root = OpREFCNT_inc(proto_perl->Imain_root);
+ OP_REFCNT_UNLOCK;
PL_main_start = proto_perl->Imain_start;
PL_eval_root = proto_perl->Ieval_root;
PL_eval_start = proto_perl->Ieval_start;
==== //depot/maint-5.8/perl/t/op/readline.t#6 (text) ====
Index: perl/t/op/readline.t
--- perl/t/op/readline.t#5~30070~ 2007-01-29 14:12:03.000000000 -0800
+++ perl/t/op/readline.t 2007-01-29 14:30:00.000000000 -0800
@@ -6,7 +6,7 @@
require './test.pl';
}
-plan tests => 15;
+plan tests => 17;
eval { for (\2) { $_ = <FH> } };
like($@, 'Modification of a read-only value attempted', '[perl #19566]');
@@ -91,9 +91,21 @@
$obj .= <DATA>;
like($obj, qr/main=ARRAY.*world/, 'rcatline and refs');
+# bug #38631
+require Tie::Scalar;
+tie our $one, 'Tie::StdScalar', "A: ";
+tie our $two, 'Tie::StdScalar', "B: ";
+my $junk = $one;
+$one .= <DATA>;
+$two .= <DATA>;
+is( $one, "A: One\n", "rcatline works with tied scalars" );
+is( $two, "B: Two\n", "rcatline works with tied scalars" );
+
__DATA__
moo
moo
rules
rules
world
+One
+Two
End of Patch.
