Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.85k stars 523 forks source link

$, untieable? #143

Closed p5pRT closed 15 years ago

p5pRT commented 24 years ago

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

Searchable as RT948$

p5pRT commented 24 years ago

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 commented 20 years ago

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 commented 20 years ago

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

p5pRT commented 20 years ago

From @abigail

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

[abigail \<!--c--> \at\ \<!--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 commented 20 years ago

From @abigail

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

[abigail \<!--c--> \at\ \<!--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 commented 20 years ago

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--> \at\ \<!--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 commented 20 years ago

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 commented 20 years ago

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@&#8203;unixbeard\.net

p5pRT commented 20 years ago

From @richardc

Inline Patch ```diff 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 commented 20 years ago

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 commented 17 years ago

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 commented 17 years ago

From avorobey@pobox.com

Inline Patch ```diff --- 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 commented 15 years ago

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 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<< >>) -=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 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@&#8203;pobox\.com

p5pRT commented 15 years ago

From @tux

On Thu\, 13 Nov 2008 16​:38​:29 -0800\, Chip Salzenberg \chip@&#8203;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 commented 15 years ago

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@&#8203;pobox\.com

p5pRT commented 15 years ago

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 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 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 ""; 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 -- ```

Chip Salzenberg \chip@&#8203;pobox\.com

p5pRT commented 15 years ago

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 commented 15 years ago

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@&#8203;pobox\.com

p5pRT commented 15 years ago

From @tux

On Fri\, 14 Nov 2008 00​:44​:36 -0800\, Chip Salzenberg \chip@&#8203;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\<\< \ >>)

-=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 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 "\"; return $$self; } package main; @​@​ -473\,9 +473\,7 @​@​ $\, = 'BOBBINS'; print "join"\, "things"\, "up\n"; EXPECT STORE set 'BOBBINS' -FETCH -FETCH -joinBOBBINSthingsBOBBINSup +join\BOBBINSthings\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 commented 15 years ago

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@&#8203;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 commented 15 years ago

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

p5pRT commented 15 years ago

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@&#8203;pobox\.com