Change 34831 by [EMAIL PROTECTED] on 2008/11/14 12:37:01
Subject: [perl #948] [PATCH] Allow tied $,
From: Chip Salzenberg <[EMAIL PROTECTED]>
Date: Fri, 14 Nov 2008 00:44:36 -0800
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embedvar.h#267 edit
... //depot/perl/ext/Devel/PPPort/parts/apidoc.fnc#11 edit
... //depot/perl/ext/XS/APItest/t/svpeek.t#5 edit
... //depot/perl/gv.c#409 edit
... //depot/perl/intrpvar.h#237 edit
... //depot/perl/mg.c#543 edit
... //depot/perl/perl.c#886 edit
... //depot/perl/perlapi.h#189 edit
... //depot/perl/pp_hot.c#591 edit
... //depot/perl/sv.c#1578 edit
... //depot/perl/t/op/tie.t#47 edit
Differences ...
==== //depot/perl/embedvar.h#267 (text+w) ====
Index: perl/embedvar.h
--- perl/embedvar.h#266~34586~ 2008-10-25 05:47:01.000000000 -0700
+++ perl/embedvar.h 2008-11-14 04:37:01.000000000 -0800
@@ -211,7 +211,7 @@
#define PL_numeric_name (vTHX->Inumeric_name)
#define PL_numeric_radix_sv (vTHX->Inumeric_radix_sv)
#define PL_numeric_standard (vTHX->Inumeric_standard)
-#define PL_ofs_sv (vTHX->Iofs_sv)
+#define PL_ofsgv (vTHX->Iofsgv)
#define PL_oldname (vTHX->Ioldname)
#define PL_op (vTHX->Iop)
#define PL_op_mask (vTHX->Iop_mask)
@@ -523,7 +523,7 @@
#define PL_Inumeric_name PL_numeric_name
#define PL_Inumeric_radix_sv PL_numeric_radix_sv
#define PL_Inumeric_standard PL_numeric_standard
-#define PL_Iofs_sv PL_ofs_sv
+#define PL_Iofsgv PL_ofsgv
#define PL_Ioldname PL_oldname
#define PL_Iop PL_op
#define PL_Iop_mask PL_op_mask
==== //depot/perl/ext/Devel/PPPort/parts/apidoc.fnc#11 (text) ====
Index: perl/ext/Devel/PPPort/parts/apidoc.fnc
--- perl/ext/Devel/PPPort/parts/apidoc.fnc#10~34130~ 2008-07-11
13:55:01.000000000 -0700
+++ perl/ext/Devel/PPPort/parts/apidoc.fnc 2008-11-14 04:37:01.000000000
-0800
@@ -302,7 +302,7 @@
mn|GV*|PL_last_in_gv
mn|SV *|PL_DBsingle
mn|SV *|PL_DBtrace
-mn|SV*|PL_ofs_sv
+mn|GV*|PL_ofsgv
mn|SV*|PL_rs
ms||djSP
m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po
==== //depot/perl/ext/XS/APItest/t/svpeek.t#5 (text) ====
Index: perl/ext/XS/APItest/t/svpeek.t
--- perl/ext/XS/APItest/t/svpeek.t#4~34639~ 2008-10-29 12:34:05.000000000
-0700
+++ perl/ext/XS/APItest/t/svpeek.t 2008-11-14 04:37:01.000000000 -0800
@@ -21,7 +21,7 @@
is (DPeek ($/), 'PVMG("\n"\0)', '$/');
is (DPeek ($\), 'PVMG()', '$\\');
is (DPeek ($.), 'PVMG()', '$.');
- is (DPeek ($,), 'PVMG()', '$,');
+ is (DPeek ($,), 'UNDEF', '$,');
is (DPeek ($;), 'PV("\34"\0)', '$;');
is (DPeek ($"), 'PV(" "\0)', '$"');
is (DPeek ($:), 'PVMG(" \n-"\0)', '$:');
==== //depot/perl/gv.c#409 (text) ====
Index: perl/gv.c
--- perl/gv.c#408~34710~ 2008-11-03 14:19:47.000000000 -0800
+++ perl/gv.c 2008-11-14 04:37:01.000000000 -0800
@@ -1409,7 +1409,6 @@
case ')':
case '<':
case '>':
- case ',':
case '\\':
case '/':
case '\001': /* $^A */
@@ -2328,7 +2327,6 @@
case ')':
case '<':
case '>':
- case ',':
case '\\':
case '/':
case '|':
==== //depot/perl/intrpvar.h#237 (text) ====
Index: perl/intrpvar.h
--- perl/intrpvar.h#236~34585~ 2008-10-25 05:23:01.000000000 -0700
+++ perl/intrpvar.h 2008-11-14 04:37:01.000000000 -0800
@@ -102,16 +102,16 @@
The GV which was last used for a filehandle input operation. (C<< <FH> >>)
-=for apidoc mn|SV*|PL_ofs_sv
+=for apidoc mn|GV*|PL_ofsgv
-The output field separator - C<$,> in Perl space.
+The glob containing the output field separator - C<*,> in Perl space.
=cut
*/
PERLVAR(Irs, SV *) /* input record separator $/ */
PERLVAR(Ilast_in_gv, GV *) /* GV used in last <FH> */
-PERLVAR(Iofs_sv, SV *) /* output field separator $, */
+PERLVAR(Iofsgv, GV *) /* GV of output field separator
*, */
PERLVAR(Idefoutgv, GV *) /* default FH for output */
PERLVARI(Ichopset, const char *, " \n-") /* $: */
PERLVAR(Iformtarget, SV *)
==== //depot/perl/mg.c#543 (text) ====
Index: perl/mg.c
--- perl/mg.c#542~34829~ 2008-11-12 21:47:34.000000000 -0800
+++ perl/mg.c 2008-11-14 04:37:01.000000000 -0800
@@ -1026,8 +1026,6 @@
if (GvIOp(PL_defoutgv))
sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 );
break;
- case ',':
- break;
case '\\':
if (PL_ors_sv)
sv_copypv(sv, PL_ors_sv);
@@ -2604,16 +2602,6 @@
PL_ors_sv = NULL;
}
break;
- case ',':
- if (PL_ofs_sv)
- SvREFCNT_dec(PL_ofs_sv);
- if (SvOK(sv) || SvGMAGICAL(sv)) {
- PL_ofs_sv = newSVsv(sv);
- }
- else {
- PL_ofs_sv = NULL;
- }
- break;
case '[':
CopARYBASE_set(&PL_compiling, SvIV(sv));
break;
==== //depot/perl/perl.c#886 (text) ====
Index: perl/perl.c
--- perl/perl.c#885~34698~ 2008-11-02 13:12:59.000000000 -0800
+++ perl/perl.c 2008-11-14 04:37:01.000000000 -0800
@@ -946,8 +946,8 @@
/* magical thingies */
- SvREFCNT_dec(PL_ofs_sv); /* $, */
- PL_ofs_sv = NULL;
+ SvREFCNT_dec(PL_ofsgv); /* *, */
+ PL_ofsgv = NULL;
SvREFCNT_dec(PL_ors_sv); /* $\ */
PL_ors_sv = NULL;
@@ -4551,6 +4551,8 @@
IO *io;
sv_setpvs(get_sv("\"", TRUE), " ");
+ PL_ofsgv = (GV*)SvREFCNT_inc(gv_fetchpvs(",", GV_ADD|GV_NOTQUAL, SVt_PV));
+
PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(PL_stdingv);
io = GvIOp(PL_stdingv);
==== //depot/perl/perlapi.h#189 (text+w) ====
Index: perl/perlapi.h
--- perl/perlapi.h#188~34586~ 2008-10-25 05:47:01.000000000 -0700
+++ perl/perlapi.h 2008-11-14 04:37:01.000000000 -0800
@@ -458,8 +458,8 @@
#define PL_numeric_radix_sv (*Perl_Inumeric_radix_sv_ptr(aTHX))
#undef PL_numeric_standard
#define PL_numeric_standard (*Perl_Inumeric_standard_ptr(aTHX))
-#undef PL_ofs_sv
-#define PL_ofs_sv (*Perl_Iofs_sv_ptr(aTHX))
+#undef PL_ofsgv
+#define PL_ofsgv (*Perl_Iofsgv_ptr(aTHX))
#undef PL_oldname
#define PL_oldname (*Perl_Ioldname_ptr(aTHX))
#undef PL_op
==== //depot/perl/pp_hot.c#591 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#590~34829~ 2008-11-12 21:47:34.000000000 -0800
+++ perl/pp_hot.c 2008-11-14 04:37:01.000000000 -0800
@@ -753,14 +753,16 @@
goto just_say_no;
}
else {
+ SV * const ofs = GvSV(PL_ofsgv); /* $, */
MARK++;
- if (PL_ofs_sv && SvOK(PL_ofs_sv)) {
+ if (ofs && (SvGMAGICAL(ofs) || SvOK(ofs))) {
while (MARK <= SP) {
if (!do_print(*MARK, fp))
break;
MARK++;
if (MARK <= SP) {
- if (!do_print(PL_ofs_sv, fp)) { /* $, */
+ /* don't use 'ofs' here - it may be invalidated by magic
callbacks */
+ if (!do_print(GvSV(PL_ofsgv), fp)) {
MARK--;
break;
}
==== //depot/perl/sv.c#1578 (text) ====
Index: perl/sv.c
--- perl/sv.c#1577~34804~ 2008-11-10 11:13:20.000000000 -0800
+++ perl/sv.c 2008-11-14 04:37:01.000000000 -0800
@@ -11761,6 +11761,7 @@
PL_regex_pad = AvARRAY(PL_regex_padav);
/* shortcuts to various I/O objects */
+ PL_ofsgv = gv_dup(proto_perl->Iofsgv, param);
PL_stdingv = gv_dup(proto_perl->Istdingv, param);
PL_stderrgv = gv_dup(proto_perl->Istderrgv, param);
PL_defgv = gv_dup(proto_perl->Idefgv, param);
@@ -12107,7 +12108,6 @@
PL_curpm = proto_perl->Icurpm; /* XXX No PMOP ref count */
PL_rs = sv_dup_inc(proto_perl->Irs, param);
PL_last_in_gv = gv_dup(proto_perl->Ilast_in_gv, param);
- PL_ofs_sv = sv_dup_inc(proto_perl->Iofs_sv, param);
PL_defoutgv = gv_dup_inc(proto_perl->Idefoutgv, param);
PL_chopset = proto_perl->Ichopset; /* XXX never deallocated */
PL_toptarget = sv_dup_inc(proto_perl->Itoptarget, param);
==== //depot/perl/t/op/tie.t#47 (xtext) ====
Index: perl/t/op/tie.t
--- perl/t/op/tie.t#46~31511~ 2007-07-01 05:30:50.000000000 -0700
+++ perl/t/op/tie.t 2008-11-14 04:37:01.000000000 -0800
@@ -447,7 +447,7 @@
ok
########
-# TODO [perl #948] cannot meaningfully tie $,
+# [perl #948] cannot meaningfully tie $,
package TieDollarComma;
sub TIESCALAR {
@@ -463,7 +463,7 @@
sub FETCH {
my $self = shift;
- print "FETCH\n";
+ print "<FETCH>";
return $$self;
}
package main;
@@ -473,9 +473,7 @@
print "join", "things", "up\n";
EXPECT
STORE set 'BOBBINS'
-FETCH
-FETCH
-joinBOBBINSthingsBOBBINSup
+join<FETCH>BOBBINSthings<FETCH>BOBBINSup
########
# test SCALAR method
End of Patch.
