Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

$, untieable? #143

Closed
p5pRT opened this issue Jul 1, 1999 · 22 comments
Closed

$, untieable? #143

p5pRT opened this issue Jul 1, 1999 · 22 comments

Comments

@p5pRT
Copy link

p5pRT commented Jul 1, 1999

Migrated from rt.perl.org#948 (status was 'resolved')

Searchable as RT948$

@p5pRT
Copy link
Author

p5pRT commented Jul 1, 1999

From @Abigail

#!/opt/perl/bin/perl -w

use strict;

$, = ","; # $, is undefined by default.

print "0​: "; print qq {[$"] [$,]}; print "\n";

tie $", 'A';
tie $,, 'A';

sub A​::TIESCALAR {bless \my $x, 'A'}
sub A​::FETCH {"<-->"}

my @​a = ("") x 5;
print "1​: "; print "@​a"; print "\n";
print "2​: "; print @​a; print "\n";
print "3​: "; print qq {[$"] [$,]}; print "\n";

__END__

0​: [ ] [,]
1​: <--><--><--><-->
2​: ,,,,
3​: [<-->] [,]

Why can I tie $", but I cannot tie $, ? Or am I missing something?

(Perl 5.005_57 gives the same output)

Abigail

Perl Info


Site configuration information for perl 5.00503:

Configured by abigail at Thu Apr  8 23:32:41 EDT 1999.

Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration:
  Platform:
    osname=linux, osvers=2.0.34, archname=i686-linux
    uname='linux alexandra 2.0.34 #2 thu jul 9 10:57:48 est 1998 i686 unknown '
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef useperlio=undef d_sfio=undef
  Compiler:
    cc='cc', optimize='-g', gccversion=2.7.2.3
    cppflags='-Dbool=char -DHAS_BOOL -DDEBUGGING -I/usr/local/include'
    ccflags ='-Dbool=char -DHAS_BOOL -DDEBUGGING -I/usr/local/include'
    stdchar='char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl 5.00503:
    /home/abigail/Perl
    /home/abigail/Sybase
    /opt/perl/lib/5.00503/i686-linux
    /opt/perl/lib/5.00503
    /opt/perl/lib/site_perl/5.005/i686-linux
    /opt/perl/lib/site_perl/5.005
    .


Environment for perl 5.00503:
    HOME=/home/abigail
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/home/abigail/Lib:/usr/local/lib:/usr/lib:/lib
    LOGDIR (unset)
    PATH=/home/abigail/Bin:/opt/perl/bin:/usr/local/bin:/usr/local/X11/bin:/usr/bin:/bin:/usr/local/sbin:/usr/sbin:/sbin:/usr/games
    PERL5LIB=/home/abigail/Perl:/home/abigail/Sybase
    PERLDIR=/opt/perl
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Jul 6, 2003

From @floatingatoll

[abigail@​delanet.com - Thu Jul 1 12​:09​:24 1999]​:

Why can I tie $", but I cannot tie $, ? Or am I missing something?

This has been fixed as of bleadperl, @​18374. Thanks for the report!

@p5pRT
Copy link
Author

p5pRT commented Jul 6, 2003

@floatingatoll - Status changed from 'open' to 'resolved'

@p5pRT
Copy link
Author

p5pRT commented Oct 20, 2003

From @Abigail

[coral - Sun Jul 6 15​:54​:50 2003]​:

[abigail <!--c--> <i>at</i> <!--a--> delanet.com - Thu Jul 1 12​:09​:24
1999]​:

Why can I tie $", but I cannot tie $, ? Or am I missing something?

This has been fixed as of bleadperl, @​18374. Thanks for the report!

Actually, it's only partially fixed. You can tie $, now, but it only
has effect if you access $, directly; not when when $, is accessed
indirectly when printing an array. This is different than the behaviour
of $" which tieable for both the direct and indirect access.

Again my original program​:

#!/opt/perl/5.9.0/bin/perl -w

use strict;

$, = ","; # $, is undefined by default.

print "0​: "; print qq {[$"] [$,]}; print "\n";

tie $", 'A';
tie $,, 'A';

sub A​::TIESCALAR {bless \my $x, 'A'}
sub A​::FETCH {"<-->"}

my @​a = ("") x 5;
print "1​: "; print "@​a"; print "\n";
print "2​: "; print @​a; print "\n";
print "3​: "; print qq {[$"] [$,]}; print "\n";
__END__

Running this gives​:

0​: [ ] [,]
1​: <--><--><--><-->
2​: ,,,,
3​: [<-->] [<-->]

We see here from the last line that if we access $" and $, directly,
the value is FETCHed. However, as the line with '2​:' shows, the value
$, is not FETCHed when there's an indirect access to $, due to the
printing of @​a. However, the indirect access to $" *is* FETCHed, as the
line with '1​:' shows.

That was my original bugreport, and I don't think patch 18374 fixed it.

Abigail

@p5pRT
Copy link
Author

p5pRT commented Oct 20, 2003

From @Abigail

[coral - Sun Jul 6 15​:54​:50 2003]​:

[abigail <!--c--> <i>at</i> <!--a--> delanet.com - Thu Jul 1 12​:09​:24
1999]​:

Why can I tie $", but I cannot tie $, ? Or am I missing something?

This has been fixed as of bleadperl, @​18374. Thanks for the report!

Actually, it's only partially fixed. You can tie $, now, but it only
has effect if you access $, directly; not when when $, is accessed
indirectly when printing an array. This is different than the behaviour
of $" which tieable for both the direct and indirect access.

Again my original program​:

#!/opt/perl/5.9.0/bin/perl -w

use strict;

$, = ","; # $, is undefined by default.

print "0​: "; print qq {[$"] [$,]}; print "\n";

tie $", 'A';
tie $,, 'A';

sub A​::TIESCALAR {bless \my $x, 'A'}
sub A​::FETCH {"<-->"}

my @​a = ("") x 5;
print "1​: "; print "@​a"; print "\n";
print "2​: "; print @​a; print "\n";
print "3​: "; print qq {[$"] [$,]}; print "\n";
__END__
Running this gives​:

0​: [ ] [,]
1​: <--><--><--><-->
2​: ,,,,
3​: [<-->] [<-->]

We see here from the last line that if we access $" and $, directly,
the value is FETCHed. However, as the line with '2​:' shows, the value
$, is not FETCHed when there's an indirect access to $, due to the
printing of @​a. However, the indirect access to $" *is* FETCHed, as the
line with '1​:' shows.

That was my original bugreport, and I don't think patch 18374 fixed it.

Abigail

@p5pRT
Copy link
Author

p5pRT commented Oct 20, 2003

From @Abigail

[I tried sending this earlier today with the bugs.perl.com website, but
it never showed up here, so I mail directly].

[coral - Sun Jul 6 15​:54​:50 2003]​:

[abigail <!--c--> <i>at</i> <!--a--> delanet.com - Thu Jul 1 12​:09​:24
1999]​:

Why can I tie $", but I cannot tie $, ? Or am I missing something?

This has been fixed as of bleadperl, @​18374. Thanks for the report!

Actually, it's only partially fixed. You can tie $, now, but it only
has effect if you access $, directly; not when when $, is accessed
indirectly when printing an array. This is different than the behaviour
of $" which tieable for both the direct and indirect access.

Again my original program​:

#!/opt/perl/5.9.0/bin/perl -w

use strict;

$, = ","; # $, is undefined by default.

print "0​: "; print qq {[$"] [$,]}; print "\n";

tie $", 'A';
tie $,, 'A';

sub A​::TIESCALAR {bless \my $x, 'A'}
sub A​::FETCH {"<-->"}

my @​a = ("") x 5;
print "1​: "; print "@​a"; print "\n";
print "2​: "; print @​a; print "\n";
print "3​: "; print qq {[$"] [$,]}; print "\n";
__END__
Running this gives​:

0​: [ ] [,]
1​: <--><--><--><-->
2​: ,,,,
3​: [<-->] [<-->]

We see here from the last line that if we access $" and $, directly,
the value is FETCHed. However, as the line with '2​:' shows, the value
$, is not FETCHed when there's an indirect access to $, due to the
printing of @​a. However, the indirect access to $" *is* FETCHed, as the
line with '1​:' shows.

That was my original bugreport, and I don't think patch 18374 fixed it.

I don't think bug #948 has been resolved, and I think it should be
re-opened (I don't have the permission to change the status back to open).

Abigail

@p5pRT
Copy link
Author

p5pRT commented Oct 20, 2003

From @nwc10

On Mon, Oct 20, 2003 at 11​:42​:55PM +0200, Abigail wrote​:

I don't think bug #948 has been resolved, and I think it should be
re-opened (I don't have the permission to change the status back to open).

It's now open again. I believe you caused this by sending a message
with [perl #948] in the subject.

As to the bug itself, at this time I have no ideas.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Oct 20, 2003

From @richardc

On Mon, Oct 20, 2003 at 11​:42​:55PM +0200, Abigail wrote​:

[I tried sending this earlier today with the bugs.perl.com website, but
it never showed up here, so I mail directly].

Robert points out that this falls under my domain. WebRT will only
mail the original requestor unless you add a CC into the box. The
simplest way to add correspondence is to send an email with the bug
cookie in your subject line.

I'll add it to the FAQ at some point RSN, I promise.

Further I pulled on my hat further and tried to cook this down into a
TODO test, a patch for which is attached. Can you confirm that this
test correctly expresses your bug?

Thanks

I don't think bug #948 has been resolved, and I think it should be
re-opened (I don't have the permission to change the status back to open).

As Nicholas has pointed out already, the simple act of attaching
commentary to the bug reopens it. I'll fit that into the FAQ too.

--
Richard Clamp <richardc@​unixbeard.net>

@p5pRT
Copy link
Author

p5pRT commented Oct 20, 2003

From @richardc

Inline Patch
diff -urb bleadperl/t/op/tie.t bleadperl_hck/t/op/tie.t
--- bleadperl/t/op/tie.t	2003-09-05 06:31:40.000000000 +0100
+++ bleadperl_hck/t/op/tie.t	2003-10-20 23:47:31.000000000 +0100
@@ -446,3 +446,34 @@
 }
 EXPECT
 ok
+########
+
+# TODO [perl #948] cannot meaningfully tie $,
+package TieDollarComma;
+
+sub TIESCALAR {
+     my $pkg = shift;
+     return bless \my $x, $pkg;
+}
+
+sub STORE {
+    my $self = shift;
+    $$self = shift;
+    print "STORE set '$$self'\n";
+}
+
+sub FETCH {
+    my $self = shift;
+    print "FETCH\n";
+    return $$self;
+}
+package main;
+
+tie $,, 'TieDollarComma';
+$, = 'BOBBINS';
+print "join", "things", "up\n";
+EXPECT
+STORE set 'BOBBINS'
+FETCH
+FETCH
+joinBOBBINSthingsBOBBINSup

@p5pRT
Copy link
Author

p5pRT commented Oct 25, 2003

From @rgs

Richard Clamp wrote​:

Further I pulled on my hat further and tried to cook this down into a
TODO test, a patch for which is attached. Can you confirm that this
test correctly expresses your bug?

Thanks, applied as #21532, along with a small fix to t/TEST so it
recognizes your test as TODO (while keeping the regular expressions
in it as simple as possible.)

@p5pRT
Copy link
Author

p5pRT commented Oct 9, 2006

From avorobey@pobox.com

I attach a one-line patch that seems OK to me, but should really be
checked by someone who understands magic better than I do (i.e.
virtually anyone).

When we update $, , its value is copied to global PL_ofs_sv via $,'s
set-magic; however, at that point $, is unmagicked and PL_ofs_sv simply
gets its value and none of its magics (including its tie magic if we
tied it). printing looks up the separator in PL_ofs_sv and so $,'s tie
magic never comes into play when printing. I suggest making PL_ofs_sv
point to the $, we changed rather than make a new copy of it with newSVsv.

Note that this doesn't pass the test, but arguably the test is wrong​: it
s expectation is based on the assumption that print '1','2','3' first
looks up $, twice to build the whole string, then prints it in one go,
whereas what pp_print() really does is print the first argument, look up
and print the separator, print the 2nd argument, etc. This behavior by
itself doesn't seem to be a bug.

@p5pRT
Copy link
Author

p5pRT commented Oct 9, 2006

From avorobey@pobox.com

Inline Patch
--- perl-5.9.4-orig/mg.c	2006-08-15 15:37:41.000000000 +0300
+++ perl-5.9.4/mg.c	2006-10-09 14:24:13.000000000 +0200
@@ -2377,7 +2377,7 @@
 	if (PL_ofs_sv)
 	    SvREFCNT_dec(PL_ofs_sv);
 	if (SvOK(sv) || SvGMAGICAL(sv)) {
-	    PL_ofs_sv = newSVsv(sv);
+	    PL_ofs_sv = SvREFCNT_inc(sv);
 	}
 	else {
 	    PL_ofs_sv = NULL;

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @chipdude

(Yes, bug #948. Kickin' it old school today.)

Abigail long ago observed that $" can be tied but $, cannot. In the spirit
of cleaning up bugs that probably date to my last stint as pumpking, here is
a first cut at a patch. It eliminates ',' magic entirely and replaces it
with a stored pointer to the *, glob.

Advanced students of the Perl guts will recognize that this change will have
subtle effects on code that manipulates the relevant symbol table entry,
e.g. via modifying $main​::{','}; but such games are extraodinarily rarely
played, at least with the *, glob, and the results of them have never been
guaranteed anyway.

This patch has two additional points of interest.

First, while an undef normal value for $, is allowed without warning, if a
tied $, returns undef from a FETCH, you'll probably get warnings from print.
I'm not sure this is worth worrying about, frankly. A tied $, can return ""
instead if it wants no separators printed.

Second, a tied $, is fetched once per use, rather than once per print. This
could be construed as a feature, if one were so inclined.

Share & Enjoy!

Inline Patch
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/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<< <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 *)
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 9615c46..d60308f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -753,14 +753,15 @@ PP(pp_print)
 	goto just_say_no;
     }
     else {
+	SV * const ofs = sv_2mortal(SvREFCNT_inc(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)) { /* $, */
+		    if (!do_print(ofs, fp)) { /* $, */
 			MARK--;
 			break;
 		    }
diff --git a/sv.c b/sv.c
index e9a384b..6083651 100644
--- a/sv.c
+++ b/sv.c
@@ -11737,6 +11737,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);
@@ -12083,7 +12084,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);

-- 

Chip Salzenberg <chip@​pobox.com>

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @Tux

On Thu, 13 Nov 2008 16​:38​:29 -0800, Chip Salzenberg <chip@​pobox.com>
wrote​:

(Yes, bug #948. Kickin' it old school today.)

Abigail long ago observed that $" can be tied but $, cannot. In the spirit
of cleaning up bugs that probably date to my last stint as pumpking, here is
a first cut at a patch. It eliminates ',' magic entirely and replaces it
with a stored pointer to the *, glob.

Advanced students of the Perl guts will recognize that this change will have
subtle effects on code that manipulates the relevant symbol table entry,
e.g. via modifying $main​::{','}; but such games are extraodinarily rarely
played, at least with the *, glob, and the results of them have never been
guaranteed anyway.

This patch has two additional points of interest.

First, while an undef normal value for $, is allowed without warning, if a
tied $, returns undef from a FETCH, you'll probably get warnings from print.
I'm not sure this is worth worrying about, frankly. A tied $, can return ""
instead if it wants no separators printed.

Second, a tied $, is fetched once per use, rather than once per print. This
could be construed as a feature, if one were so inclined.

It is really wonderful to see you dig in like this! :)
I miss some tests

Do you still have your commits? I don't think the community would
object to you using them again

Share & Enjoy!

--
H.Merijn Brand Amsterdam Perl Mongers http​://amsterdam.pm.org/
using & porting perl 5.6.2, 5.8.x, 5.10.x, 5.11.x on HP-UX 10.20, 11.00,
11.11, 11.23, and 11.31, SuSE 10.1, 10.2, and 10.3, AIX 5.2, and Cygwin.
http​://mirrors.develooper.com/hpux/ http​://www.test-smoke.org/
http​://qa.perl.org http​://www.goldmark.org/jeff/stupid-disclaimers/

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @chipdude

On Fri, Nov 14, 2008 at 08​:43​:00AM +0100, H.Merijn Brand wrote​:

It is really wonderful to see you dig in like this! :)

One never forgets, apparently; rather like a bicycle, or a conditioned
salivation when a bug is filed. :-)

I miss some tests

There is a test in RT. I'll add it to the next version of the patch.

Do you still have your commits? I don't think the community would
object to you using them again

Due to bit rot of various kinds, I haven't had perforce commit access for a
while. I've been planning to request a git commit bit, once that's live.
In the meantime, if the pumpkings complain about the patch load [​:-)] I'm
happy to use perforce again.
--
Chip Salzenberg <chip@​pobox.com>

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @chipdude

On Fri, Nov 14, 2008 at 12​:12​:59AM -0800, Chip Salzenberg wrote​:

On Fri, Nov 14, 2008 at 08​:43​:00AM +0100, H.Merijn Brand wrote​:

I miss some tests
There is a test in RT.

Actually it turns out the test had already been applied in t/op/tie.t, but
marked as a TODO. So I've de-TODO'd it and adjusted it so it reflects what
the code does. And now it passes. :-)

Here's the new patch. I think this is ready to go.

Inline Patch
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<< <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 *)
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 9615c46..5530c17 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 e9a384b..6083651 100644
--- a/sv.c
+++ b/sv.c
@@ -11737,6 +11737,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);
@@ -12083,7 +12084,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 "<FETCH>";
     return $$self;
 }
 package main;
@@ -473,9 +473,7 @@ $, = 'BOBBINS';
 print "join", "things", "up\n";
 EXPECT
 STORE set 'BOBBINS'
-FETCH
-FETCH
-joinBOBBINSthingsBOBBINSup
+join<FETCH>BOBBINSthings<FETCH>BOBBINSup
 ########
 
 # test SCALAR method

-- 

Chip Salzenberg <chip@​pobox.com>

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @Abigail

On Fri, Nov 14, 2008 at 12​:44​:36AM -0800, Chip Salzenberg wrote​:

On Fri, Nov 14, 2008 at 12​:12​:59AM -0800, Chip Salzenberg wrote​:

On Fri, Nov 14, 2008 at 08​:43​:00AM +0100, H.Merijn Brand wrote​:

I miss some tests
There is a test in RT.

Actually it turns out the test had already been applied in t/op/tie.t, but
marked as a TODO. So I've de-TODO'd it and adjusted it so it reflects what
the code does. And now it passes. :-)

Here's the new patch. I think this is ready to go.

Congrats! I think this was the oldest open perl5 bug in the RT system,
dating from Jul 1, 1999.

I can now pass the 'honour' of having reported the oldest open perl5
bug to Jarkko (#969).

Too bad I can't remember what JAPH I wanted to write when I stumbled
upon untieable $,

Abigail

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @chipdude

On Fri, Nov 14, 2008 at 10​:55​:02AM +0100, Abigail wrote​:

Congrats! I think this was the oldest open perl5 bug in the RT system,
dating from Jul 1, 1999.

At this rate, I should have the queue cleared out in a year or so.
(And my family life. :-))

I can now pass the 'honour' of having reported the oldest open perl5
bug to Jarkko (#969).

And on that bug, I've asked for clarification on whether that fix absolutely
*has* to use the >> and << operators. Perhaps we'll soon be able to shift
someone else into the place of honor.

Too bad I can't remember what JAPH I wanted to write when I stumbled
upon untieable $,

Well, nothing's stopping you from making a new one... :-)
--
Chip Salzenberg <chip@​pobox.com>

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @Tux

On Fri, 14 Nov 2008 00​:44​:36 -0800, Chip Salzenberg <chip@​pobox.com>
wrote​:

On Fri, Nov 14, 2008 at 12​:12​:59AM -0800, Chip Salzenberg wrote​:

On Fri, Nov 14, 2008 at 08​:43​:00AM +0100, H.Merijn Brand wrote​:

I miss some tests
There is a test in RT.

Actually it turns out the test had already been applied in t/op/tie.t, but
marked as a TODO. So I've de-TODO'd it and adjusted it so it reflects what
the code does. And now it passes. :-)

Thanks, applied as change #34831

Here's the new patch. I think this is ready to go.

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<< <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 *)
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 9615c46..5530c17 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 e9a384b..6083651 100644
--- a/sv.c
+++ b/sv.c
@​@​ -11737,6 +11737,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);
@​@​ -12083,7 +12084,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 "<FETCH>";
return $$self;
}
package main;
@​@​ -473,9 +473,7 @​@​ $, = 'BOBBINS';
print "join", "things", "up\n";
EXPECT
STORE set 'BOBBINS'
-FETCH
-FETCH
-joinBOBBINSthingsBOBBINSup
+join<FETCH>BOBBINSthings<FETCH>BOBBINSup
########

# test SCALAR method

--
H.Merijn Brand Amsterdam Perl Mongers http​://amsterdam.pm.org/
using & porting perl 5.6.2, 5.8.x, 5.10.x, 5.11.x on HP-UX 10.20, 11.00,
11.11, 11.23, and 11.31, SuSE 10.1, 10.2, and 10.3, AIX 5.2, and Cygwin.
http​://mirrors.develooper.com/hpux/ http​://www.test-smoke.org/
http​://qa.perl.org http​://www.goldmark.org/jeff/stupid-disclaimers/

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @mhx

On 2008-11-14, at 13​:37​:52 +0100, H.Merijn Brand wrote​:

On Fri, 14 Nov 2008 00​:44​:36 -0800, Chip Salzenberg <chip@​pobox.com>
wrote​:

On Fri, Nov 14, 2008 at 12​:12​:59AM -0800, Chip Salzenberg wrote​:

On Fri, Nov 14, 2008 at 08​:43​:00AM +0100, H.Merijn Brand wrote​:

I miss some tests
There is a test in RT.

Actually it turns out the test had already been applied in t/op/tie.t, but
marked as a TODO. So I've de-TODO'd it and adjusted it so it reflects what
the code does. And now it passes. :-)

Thanks, applied as change #34831

Here's the new patch. I think this is ready to go.

[...]

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

Please, don't patch Devel​::PPPort until it's really broken.
Especially, don't patch files with a "Do NOT edit" note in
their header [1].

This file is regenerated only from time to time, usually
before stable releases of Devel​::PPPort. I guess there's
currently a lot more not in sync with blead in this file
than this particular line... ;)

(No need to revert that part, it'll be fixed with the next
upgrade of D​::PPP anyway.)

Thanks,
Marcus

PS​: Once more, very nice fix! :)

[1] Even though the note is slightly wrong​: it points
  to PPPort_pm.PL where it should rather point to
  devel/mkapidoc.sh.

--
If in any problem you find yourself doing an immense amount of work, the
answer can be obtained by simple inspection.

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

@smpeters - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this as completed Nov 14, 2008
@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2008

From @chipdude

On Fri, Nov 14, 2008 at 02​:52​:41PM +0100, Marcus Holland-Moritz wrote​:

Please, don't patch Devel​::PPPort until it's really broken.
Especially, don't patch files with a "Do NOT edit" note in
their header [1].

D'oh. Shall (not) do.

(No need to revert that part, it'll be fixed with the next
upgrade of D​::PPP anyway.)

If I had access, though, I would revert it. No point in confusing the
change history further.
--
Chip Salzenberg <chip@​pobox.com>

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant