[perl #8698] format bug with undefined _TOP

name of format_TOP now derived from the name of the current
filehandle rather then the name of the  format associetd with that
handle

p4raw-id: //depot/perl@22162

diff --git a/pp_sys.c b/pp_sys.c
index 259c926..3de073d 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1327,7 +1327,7 @@ PP(pp_leavewrite)
            if (!IoTOP_NAME(io)) {
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
-               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", IoFMT_NAME(io)));
+               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
                topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                  !gv_fetchpv("top",FALSE,SVt_PVFM))

diff --git a/t/op/write.t b/t/op/write.t
index 6e37cac..9224d2f 100755 (executable)
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -531,23 +531,27 @@ ok @<<<<<
 $test
 .
 
-$= = 10;
 
 # [ID 20020227.005] format bug with undefined _TOP
+
+open STDOUT_DUP, ">&STDOUT";
+my $oldfh = select STDOUT_DUP;
+$= = 10;
 {   local $~ = "Comment";
     write;
     $test++;
     print $- == 9
        ? "ok $test # TODO\n" : "not ok $test # TODO \$- = $- instead of 9\n";
     $test++;
-    print $^ ne "Comment_TOP"
-       ? "ok $test\n" : "not ok $test # TODO \$^ = $^ instead of 'STDOUT_TOP'\n";
+    print $^ eq "STDOUT_DUP_TOP"
+       ? "ok $test\n" : "not ok $test\n# \$^ = $^ instead of 'STDOUT_DUP_TOP'\n";
     $test++;
-    }
+}
+select $oldfh;
 
-   $^  = "STDOUT_TOP";
-   $=  =  7;           # Page length
-   $-  =  0;           # Lines left
+$^  = "STDOUT_TOP";
+$=  =  7;              # Page length
+$-  =  0;              # Lines left
 my $ps = $^L; $^L = "";        # Catch the page separator
 my $tm =  1;           # Top margin (empty lines before first output)
 my $bm =  2;           # Bottom marging (empty lines between last text and footer)