Now that the bug is fixed, and the patch is accepted (as patch 6340), I wanted to extend the knowledge I picked up along the way. Realizing that at the moment it is not possible to detect if a format is defined at all, because globs cannot deal with it's FORMAT entry. Making glob's do what they should do for formats too, i.e. make *TOP{FORMAT} be as valid as *TOP{SCALAR}, *TOP{HASH} and all known other glob entries.
I was talking about this with Jan-Pieter Cornet on our way to TPC4, and we decided to give it a shot, and hacked towards it in the plane. We did the right patch, but made a wrong test for it, so we didn't trust ourselves in submitting it. Graham Barr helped us with the test
--- perl/pp.c.org Wed Jul 26 11:47:23 2000 +++ perl/pp.c Wed Jul 26 11:47:23 2000 @@ -599,6 +599,9 @@ case 'F': if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ tmpRef = (SV*)GvIOp(gv); + else + if (strEQ(elem, "FORMAT")) + tmpRef = (SV*)GvFORM(gv); break; case 'G': if (strEQ(elem, "GLOB")) --- perl/sv.c.org Wed Jul 26 11:47:23 2000 +++ perl/sv.c Wed Jul 26 11:47:23 2000 @@ -2831,6 +2831,13 @@ dref = (SV*)GvIOp(dstr); GvIOp(dstr) = (IO*)sref; break; + case SVt_PVFM: + if (intro) + SAVESPTR(GvFORM(dstr)); + else + dref = (SV*)GvFORM(dstr); + GvFORM(dstr) = (CV*)sref; + break; default: if (intro) SAVESPTR(GvSV(dstr)); End of Patch.
Ahh, and let not forget that test, so the patch might be accepted again:
--- perl/t/op/gv.t.org Wed Jul 26 11:47:23 2000 +++ perl/t/op/gv.t Wed Jul 26 11:47:23 2000 @@ -11,7 +11,7 @@ use warnings; -print "1..40\n"; +print "1..41\n"; # type coersion on assignment $foo = 'foo'; @@ -97,15 +97,19 @@ %x = ("ok 19" => "\n"); sub x { "ok 20\n" } print ${*x{SCALAR}}, @{*x{ARRAY}}, %{*x{HASH}}, &{*x{CODE}}; +format x = +ok 21 +. +print ref *x{FORMAT} eq "FORMAT" ? "ok 21\n" : "not ok 21\n"; *x = *STDOUT; -print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 21\n" : "not ok 21\n"; -print {*x{IO}} "ok 22\n"; -print {*x{FILEHANDLE}} "ok 23\n"; +print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 22\n" : "not ok 22\n"; +print {*x{IO}} "ok 23\n"; +print {*x{FILEHANDLE}} "ok 24\n"; # test if defined() doesn't create any new symbols { - my $test = 23; + my $test = 24; my $a = "SYM000"; print "not " if defined *{$a}; @@ -131,7 +135,7 @@ # although it *should* if you're talking about magicals { - my $test = 29; + my $test = 30; my $a = "]"; print "not " unless defined ${$a}; @@ -173,4 +177,4 @@ } __END__ -ok 40 +ok 41 End of Patch.
This patch also made it through to the core, but was rejected by Gurusamy Sarathy for the 5.6.0 and 5.6.1 track. His motivations were not convincing for me, and some discussions with Gurusamy and Jarkko led to acceptation in the 5.7 development track (where it has always been) and eventually the patch is accepted also for the 5.8.0 release of Perl.