From: Chip Salzenberg Date: Fri, 14 Nov 2008 00:44:36 +0000 (-0800) Subject: [perl #948] [PATCH] Allow tied $, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e23d9e2f39425eea292ee5999c974fdc2cdd98b8;p=p5sagit%2Fp5-mst-13.2.git [perl #948] [PATCH] Allow tied $, Message-ID: <20081114084436.GJ5779@tytlal.topaz.cx> p4raw-id: //depot/perl@34831 --- diff --git a/embedvar.h b/embedvar.h index 877dd28..6ea599f 100644 --- a/embedvar.h +++ b/embedvar.h @@ -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 diff --git a/ext/Devel/PPPort/parts/apidoc.fnc b/ext/Devel/PPPort/parts/apidoc.fnc index 63b9746..a6896bb 100644 --- a/ext/Devel/PPPort/parts/apidoc.fnc +++ b/ext/Devel/PPPort/parts/apidoc.fnc @@ -302,7 +302,7 @@ mn|GV *|PL_DBsub 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 diff --git a/ext/XS/APItest/t/svpeek.t b/ext/XS/APItest/t/svpeek.t index 69d80d7..8226386 100644 --- a/ext/XS/APItest/t/svpeek.t +++ b/ext/XS/APItest/t/svpeek.t @@ -21,7 +21,7 @@ $| = 1; 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)', '$:'); diff --git a/gv.c b/gv.c index 5bf82f2..f278e37 100644 --- a/gv.c +++ b/gv.c @@ -1409,7 +1409,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case ')': case '<': case '>': - case ',': case '\\': case '/': case '\001': /* $^A */ @@ -2328,7 +2327,6 @@ Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags) case ')': case '<': case '>': - case ',': case '\\': case '/': case '|': diff --git a/intrpvar.h b/intrpvar.h index 0a8d105..e5c9e3b 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -102,16 +102,16 @@ The input record separator - C<$/> in Perl space. The GV which was last used for a filehandle input operation. (C<< >>) -=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 */ -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 *) diff --git a/mg.c b/mg.c index a9cffbf..6f4cc58 100644 --- a/mg.c +++ b/mg.c @@ -1026,8 +1026,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) 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 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) 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; diff --git a/perl.c b/perl.c index 2489917..3876a78 100644 --- a/perl.c +++ b/perl.c @@ -946,8 +946,8 @@ perl_destruct(pTHXx) /* 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 @@ S_init_predump_symbols(pTHX) 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); diff --git a/perlapi.h b/perlapi.h index 4578824..b913b53 100644 --- a/perlapi.h +++ b/perlapi.h @@ -458,8 +458,8 @@ END_EXTERN_C #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 diff --git a/pp_hot.c b/pp_hot.c index e22502f..a60a176 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -753,14 +753,16 @@ PP(pp_print) 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; } diff --git a/sv.c b/sv.c index bae7604..efa347b 100644 --- a/sv.c +++ b/sv.c @@ -11761,6 +11761,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, 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); diff --git a/t/op/tie.t b/t/op/tie.t index 5ea2cda..51c8484 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -447,7 +447,7 @@ EXPECT ok ######## -# TODO [perl #948] cannot meaningfully tie $, +# [perl #948] cannot meaningfully tie $, package TieDollarComma; sub TIESCALAR { @@ -463,7 +463,7 @@ sub STORE { sub FETCH { my $self = shift; - print "FETCH\n"; + print ""; return $$self; } package main; @@ -473,9 +473,7 @@ $, = 'BOBBINS'; print "join", "things", "up\n"; EXPECT STORE set 'BOBBINS' -FETCH -FETCH -joinBOBBINSthingsBOBBINSup +joinBOBBINSthingsBOBBINSup ######## # test SCALAR method