Remove the extraneous "main::" prefix from all the

"opened only for", "on closed", and "never opened" warnings.

Subject: Re: inappropriate warning
Message-Id: <200003201928.LAA32224@maul.ActiveState.com>

p4raw-id: //depot/perl@6489

diff --git a/doio.c b/doio.c
index 19f7861..db570d1 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -879,7 +879,7 @@ Perl_do_eof(pTHX_ GV *gv)
                 || IoIFP(io) == PerlIO_stderr()))
     {
        SV* sv = sv_newmortal();
-       gv_efullname3(sv, gv, Nullch);
+       gv_efullname4(sv, gv, Nullch, FALSE);
        Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
                    SvPV_nolen(sv));
     }

diff --git a/embed.h b/embed.h
index d062f06..f0bae6f 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -230,6 +230,7 @@
 #define gv_check               Perl_gv_check
 #define gv_efullname           Perl_gv_efullname
 #define gv_efullname3          Perl_gv_efullname3
+#define gv_efullname4          Perl_gv_efullname4
 #define gv_fetchfile           Perl_gv_fetchfile
 #define gv_fetchmeth           Perl_gv_fetchmeth
 #define gv_fetchmethod         Perl_gv_fetchmethod
@@ -237,6 +238,7 @@
 #define gv_fetchpv             Perl_gv_fetchpv
 #define gv_fullname            Perl_gv_fullname
 #define gv_fullname3           Perl_gv_fullname3
+#define gv_fullname4           Perl_gv_fullname4
 #define gv_init                        Perl_gv_init
 #define gv_stashpv             Perl_gv_stashpv
 #define gv_stashpvn            Perl_gv_stashpvn
@@ -1688,6 +1690,7 @@
 #define gv_check(a)            Perl_gv_check(aTHX_ a)
 #define gv_efullname(a,b)      Perl_gv_efullname(aTHX_ a,b)
 #define gv_efullname3(a,b,c)   Perl_gv_efullname3(aTHX_ a,b,c)
+#define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d)
 #define gv_fetchfile(a)                Perl_gv_fetchfile(aTHX_ a)
 #define gv_fetchmeth(a,b,c,d)  Perl_gv_fetchmeth(aTHX_ a,b,c,d)
 #define gv_fetchmethod(a,b)    Perl_gv_fetchmethod(aTHX_ a,b)
@@ -1695,6 +1698,7 @@
 #define gv_fetchpv(a,b,c)      Perl_gv_fetchpv(aTHX_ a,b,c)
 #define gv_fullname(a,b)       Perl_gv_fullname(aTHX_ a,b)
 #define gv_fullname3(a,b,c)    Perl_gv_fullname3(aTHX_ a,b,c)
+#define gv_fullname4(a,b,c,d)  Perl_gv_fullname4(aTHX_ a,b,c,d)
 #define gv_init(a,b,c,d,e)     Perl_gv_init(aTHX_ a,b,c,d,e)
 #define gv_stashpv(a,b)                Perl_gv_stashpv(aTHX_ a,b)
 #define gv_stashpvn(a,b,c)     Perl_gv_stashpvn(aTHX_ a,b,c)
@@ -3305,6 +3309,8 @@
 #define gv_efullname           Perl_gv_efullname
 #define Perl_gv_efullname3     CPerlObj::Perl_gv_efullname3
 #define gv_efullname3          Perl_gv_efullname3
+#define Perl_gv_efullname4     CPerlObj::Perl_gv_efullname4
+#define gv_efullname4          Perl_gv_efullname4
 #define Perl_gv_fetchfile      CPerlObj::Perl_gv_fetchfile
 #define gv_fetchfile           Perl_gv_fetchfile
 #define Perl_gv_fetchmeth      CPerlObj::Perl_gv_fetchmeth
@@ -3319,6 +3325,8 @@
 #define gv_fullname            Perl_gv_fullname
 #define Perl_gv_fullname3      CPerlObj::Perl_gv_fullname3
 #define gv_fullname3           Perl_gv_fullname3
+#define Perl_gv_fullname4      CPerlObj::Perl_gv_fullname4
+#define gv_fullname4           Perl_gv_fullname4
 #define Perl_gv_init           CPerlObj::Perl_gv_init
 #define gv_init                        Perl_gv_init
 #define Perl_gv_stashpv                CPerlObj::Perl_gv_stashpv

diff --git a/embed.pl b/embed.pl
index 0848eec..e851a7a 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1545,6 +1545,7 @@ Ap        |GV*    |gv_autoload4   |HV* stash|const char* name|STRLEN len \
 Ap     |void   |gv_check       |HV* stash
 Ap     |void   |gv_efullname   |SV* sv|GV* gv
 Ap     |void   |gv_efullname3  |SV* sv|GV* gv|const char* prefix
+Ap     |void   |gv_efullname4  |SV* sv|GV* gv|const char* prefix|bool keepmain
 Ap     |GV*    |gv_fetchfile   |const char* name
 Apd    |GV*    |gv_fetchmeth   |HV* stash|const char* name|STRLEN len \
                                |I32 level
@@ -1554,6 +1555,7 @@ Apd       |GV*    |gv_fetchmethod_autoload|HV* stash|const char* name \
 Ap     |GV*    |gv_fetchpv     |const char* name|I32 add|I32 sv_type
 Ap     |void   |gv_fullname    |SV* sv|GV* gv
 Ap     |void   |gv_fullname3   |SV* sv|GV* gv|const char* prefix
+Ap     |void   |gv_fullname4   |SV* sv|GV* gv|const char* prefix|bool keepmain
 Ap     |void   |gv_init        |GV* gv|HV* stash|const char* name \
                                |STRLEN len|int multi
 Apd    |HV*    |gv_stashpv     |const char* name|I32 create

diff --git a/gv.c b/gv.c
index 22e419e..02f428b 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -919,6 +919,22 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
 }
 
 void
+Perl_gv_fullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain)
+{
+    HV *hv = GvSTASH(gv);
+    if (!hv) {
+       (void)SvOK_off(sv);
+       return;
+    }
+    sv_setpv(sv, prefix ? prefix : "");
+    if (keepmain || strNE(HvNAME(hv), "main")) {
+       sv_catpv(sv,HvNAME(hv));
+       sv_catpvn(sv,"::", 2);
+    }
+    sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
+}
+
+void
 Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
 {
     HV *hv = GvSTASH(gv);
@@ -933,6 +949,15 @@ Perl_gv_fullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
 }
 
 void
+Perl_gv_efullname4(pTHX_ SV *sv, GV *gv, const char *prefix, bool keepmain)
+{
+    GV *egv = GvEGV(gv);
+    if (!egv)
+       egv = gv;
+    gv_fullname4(sv, egv, prefix, keepmain);
+}
+
+void
 Perl_gv_efullname3(pTHX_ SV *sv, GV *gv, const char *prefix)
 {
     GV *egv = GvEGV(gv);

diff --git a/objXSUB.h b/objXSUB.h
index fb501c3..3e0ccce 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -423,6 +423,10 @@
 #define Perl_gv_efullname3     pPerl->Perl_gv_efullname3
 #undef  gv_efullname3
 #define gv_efullname3          Perl_gv_efullname3
+#undef  Perl_gv_efullname4
+#define Perl_gv_efullname4     pPerl->Perl_gv_efullname4
+#undef  gv_efullname4
+#define gv_efullname4          Perl_gv_efullname4
 #undef  Perl_gv_fetchfile
 #define Perl_gv_fetchfile      pPerl->Perl_gv_fetchfile
 #undef  gv_fetchfile
@@ -451,6 +455,10 @@
 #define Perl_gv_fullname3      pPerl->Perl_gv_fullname3
 #undef  gv_fullname3
 #define gv_fullname3           Perl_gv_fullname3
+#undef  Perl_gv_fullname4
+#define Perl_gv_fullname4      pPerl->Perl_gv_fullname4
+#undef  gv_fullname4
+#define gv_fullname4           Perl_gv_fullname4
 #undef  Perl_gv_init
 #define Perl_gv_init           pPerl->Perl_gv_init
 #undef  gv_init

diff --git a/pp_hot.c b/pp_hot.c
index 39cc0e0..fde52c5 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -400,7 +400,7 @@ PP(pp_print)
     if (!(io = GvIO(gv))) {
        if (ckWARN(WARN_UNOPENED)) {
            SV* sv = sv_newmortal();
-           gv_efullname3(sv, gv, Nullch);
+           gv_efullname4(sv, gv, Nullch, FALSE);
             Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened",
                        SvPV(sv,n_a));
         }
@@ -411,7 +411,7 @@ PP(pp_print)
        if (ckWARN2(WARN_CLOSED, WARN_IO))  {
            if (IoIFP(io)) {
                SV* sv = sv_newmortal();
-               gv_efullname3(sv, gv, Nullch);
+               gv_efullname4(sv, gv, Nullch, FALSE);
                Perl_warner(aTHX_ WARN_IO,
                            "Filehandle %s opened only for input",
                            SvPV(sv,n_a));
@@ -1382,7 +1382,7 @@ Perl_do_readline(pTHX)
                     || fp == PerlIO_stderr()))
        {
            SV* sv = sv_newmortal();
-           gv_efullname3(sv, PL_last_in_gv, Nullch);
+           gv_efullname4(sv, PL_last_in_gv, Nullch, FALSE);
            Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
                        SvPV_nolen(sv));
        }

diff --git a/pp_sys.c b/pp_sys.c
index 1ea47cf..ff69a8f 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1070,7 +1070,7 @@ PP(pp_select)
     else {
        GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
        if (gvp && *gvp == egv) {
-           gv_efullname3(TARG, PL_defoutgv, Nullch);
+           gv_efullname4(TARG, PL_defoutgv, Nullch, FALSE);
            XPUSHTARG;
        }
        else {
@@ -1176,7 +1176,7 @@ PP(pp_enterwrite)
     if (!cv) {
        if (fgv) {
            SV *tmpsv = sv_newmortal();
-           gv_efullname3(tmpsv, fgv, Nullch);
+           gv_efullname4(tmpsv, fgv, Nullch, FALSE);
            DIE(aTHX_ "Undefined format \"%s\" called",SvPVX(tmpsv));
        }
        DIE(aTHX_ "Not a format reference");
@@ -1257,7 +1257,7 @@ PP(pp_leavewrite)
        cv = GvFORM(fgv);
        if (!cv) {
            SV *tmpsv = sv_newmortal();
-           gv_efullname3(tmpsv, fgv, Nullch);
+           gv_efullname4(tmpsv, fgv, Nullch, FALSE);
            DIE(aTHX_ "Undefined top format \"%s\" called",SvPVX(tmpsv));
        }
        if (CvCLONE(cv))
@@ -1275,7 +1275,7 @@ PP(pp_leavewrite)
        if (ckWARN2(WARN_CLOSED,WARN_IO)) {
            if (IoIFP(io)) {
                SV* sv = sv_newmortal();
-               gv_efullname3(sv, gv, Nullch);
+               gv_efullname4(sv, gv, Nullch, FALSE);
                Perl_warner(aTHX_ WARN_IO,
                            "Filehandle %s opened only for input",
                            SvPV_nolen(sv));
@@ -1345,7 +1345,7 @@ PP(pp_prtf)
     sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
        if (ckWARN(WARN_UNOPENED)) {
-           gv_efullname3(sv, gv, Nullch);
+           gv_efullname4(sv, gv, Nullch, FALSE);
            Perl_warner(aTHX_ WARN_UNOPENED,
                        "Filehandle %s never opened", SvPV(sv,n_a));
        }
@@ -1355,7 +1355,7 @@ PP(pp_prtf)
     else if (!(fp = IoOFP(io))) {
        if (ckWARN2(WARN_CLOSED,WARN_IO))  {
            if (IoIFP(io)) {
-               gv_efullname3(sv, gv, Nullch);
+               gv_efullname4(sv, gv, Nullch, FALSE);
                Perl_warner(aTHX_ WARN_IO,
                            "Filehandle %s opened only for input",
                            SvPV(sv,n_a));
@@ -1551,7 +1551,7 @@ PP(pp_sysread)
            || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
        {
            SV* sv = sv_newmortal();
-           gv_efullname3(sv, gv, Nullch);
+           gv_efullname4(sv, gv, Nullch, FALSE);
            Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
                        SvPV_nolen(sv));
        }

diff --git a/proto.h b/proto.h
index 714c923..28597ea 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -292,6 +292,7 @@ PERL_CALLCONV GV*   Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN le
 PERL_CALLCONV void     Perl_gv_check(pTHX_ HV* stash);
 PERL_CALLCONV void     Perl_gv_efullname(pTHX_ SV* sv, GV* gv);
 PERL_CALLCONV void     Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char* prefix);
+PERL_CALLCONV void     Perl_gv_efullname4(pTHX_ SV* sv, GV* gv, const char* prefix, bool keepmain);
 PERL_CALLCONV GV*      Perl_gv_fetchfile(pTHX_ const char* name);
 PERL_CALLCONV GV*      Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level);
 PERL_CALLCONV GV*      Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name);
@@ -299,6 +300,7 @@ PERL_CALLCONV GV*   Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name
 PERL_CALLCONV GV*      Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type);
 PERL_CALLCONV void     Perl_gv_fullname(pTHX_ SV* sv, GV* gv);
 PERL_CALLCONV void     Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char* prefix);
+PERL_CALLCONV void     Perl_gv_fullname4(pTHX_ SV* sv, GV* gv, const char* prefix, bool keepmain);
 PERL_CALLCONV void     Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi);
 PERL_CALLCONV HV*      Perl_gv_stashpv(pTHX_ const char* name, I32 create);
 PERL_CALLCONV HV*      Perl_gv_stashpvn(pTHX_ const char* name, U32 namelen, I32 create);

diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint
index 3f9a897..848822d 100644 (file)
--- a/t/pragma/warn/4lint
+++ b/t/pragma/warn/4lint
@@ -9,14 +9,14 @@ $a =+ 1 ;
 close STDIN ; print STDIN "abc" ;
 EXPECT
 Reversed += operator at - line 5.
-print() on closed filehandle main::STDIN at - line 6.
+print() on closed filehandle STDIN at - line 6.
 ########
 -W
 # lint: check runtime $^W is zapped
 $^W = 0 ;
 close STDIN ; print STDIN "abc" ;
 EXPECT
-print() on closed filehandle main::STDIN at - line 4.
+print() on closed filehandle STDIN at - line 4.
 ########
 -W
 # lint: check runtime $^W is zapped
@@ -25,7 +25,7 @@ print() on closed filehandle main::STDIN at - line 4.
   close STDIN ; print STDIN "abc" ;
 }
 EXPECT
-print() on closed filehandle main::STDIN at - line 5.
+print() on closed filehandle STDIN at - line 5.
 ########
 -W
 # lint: check "no warnings" is zapped
@@ -35,7 +35,7 @@ $a =+ 1 ;
 close STDIN ; print STDIN "abc" ;
 EXPECT
 Reversed += operator at - line 5.
-print() on closed filehandle main::STDIN at - line 6.
+print() on closed filehandle STDIN at - line 6.
 ########
 -W
 # lint: check "no warnings" is zapped
@@ -44,7 +44,7 @@ print() on closed filehandle main::STDIN at - line 6.
   close STDIN ; print STDIN "abc" ;
 }
 EXPECT
-print() on closed filehandle main::STDIN at - line 5.
+print() on closed filehandle STDIN at - line 5.
 ########
 -Ww
 # lint: check combination of -w and -W
@@ -53,7 +53,7 @@ print() on closed filehandle main::STDIN at - line 5.
   close STDIN ; print STDIN "abc" ;
 }
 EXPECT
-print() on closed filehandle main::STDIN at - line 5.
+print() on closed filehandle STDIN at - line 5.
 ########
 -W
 --FILE-- abc.pm

diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio
index bd40972..8fda1e9 100644 (file)
--- a/t/pragma/warn/doio
+++ b/t/pragma/warn/doio
@@ -188,4 +188,4 @@ my $a = eof STDOUT ;
 no warnings 'io' ;
 $a = eof STDOUT ;
 EXPECT
-Filehandle main::STDOUT opened only for output at - line 3.
+Filehandle STDOUT opened only for output at - line 3.

diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
index 2759057..fe874ef 100644 (file)
--- a/t/pragma/warn/pp_hot
+++ b/t/pragma/warn/pp_hot
@@ -52,7 +52,7 @@ print $f $a;
 no warnings 'unopened' ;
 print $f $a;
 EXPECT
-Filehandle main::abc never opened at - line 4.
+Filehandle abc never opened at - line 4.
 ########
 # pp_hot.c [pp_print]
 use warnings 'io' ;
@@ -71,12 +71,12 @@ print getc(FOO);
 no warnings 'io' ;
 print STDIN "anc";
 EXPECT
-Filehandle main::STDIN opened only for input at - line 3.
-Filehandle main::STDOUT opened only for output at - line 4.
-Filehandle main::STDERR opened only for output at - line 5.
-Filehandle main::FOO opened only for output at - line 6.
-Filehandle main::STDERR opened only for output at - line 7.
-Filehandle main::FOO opened only for output at - line 8.
+Filehandle STDIN opened only for input at - line 3.
+Filehandle STDOUT opened only for output at - line 4.
+Filehandle STDERR opened only for output at - line 5.
+Filehandle FOO opened only for output at - line 6.
+Filehandle STDERR opened only for output at - line 7.
+Filehandle FOO opened only for output at - line 8.
 ########
 # pp_hot.c [pp_print]
 use warnings 'closed' ;
@@ -90,9 +90,9 @@ print STDIN "anc";
 opendir STDIN, ".";
 print STDIN "anc";
 EXPECT
-print() on closed filehandle main::STDIN at - line 4.
-print() on closed filehandle main::STDIN at - line 6.
-       (Are you trying to call print() on dirhandle main::STDIN?)
+print() on closed filehandle STDIN at - line 4.
+print() on closed filehandle STDIN at - line 6.
+       (Are you trying to call print() on dirhandle STDIN?)
 ########
 # pp_hot.c [pp_rv2av]
 use warnings 'uninitialized' ;
@@ -137,9 +137,9 @@ no warnings 'closed' ;
 opendir STDIN, "." ; $a = <STDIN> ;
 $a = <STDIN> ;
 EXPECT
-readline() on closed filehandle main::STDIN at - line 3.
-readline() on closed filehandle main::STDIN at - line 4.
-       (Are you trying to call readline() on dirhandle main::STDIN?)
+readline() on closed filehandle STDIN at - line 3.
+readline() on closed filehandle STDIN at - line 4.
+       (Are you trying to call readline() on dirhandle STDIN?)
 ########
 # pp_hot.c [Perl_do_readline]
 use warnings 'io' ;
@@ -150,7 +150,7 @@ no warnings 'io' ;
 $a = <FH> ;
 unlink $file ;
 EXPECT
-Filehandle main::FH opened only for output at - line 5.
+Filehandle FH opened only for output at - line 5.
 ########
 # pp_hot.c [Perl_sub_crush_depth]
 use warnings 'recursion' ;

diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
index 7c38727..3b9b2e0 100644 (file)
--- a/t/pragma/warn/pp_sys
+++ b/t/pragma/warn/pp_sys
@@ -107,7 +107,7 @@ write STDIN;
 no warnings 'io' ;
 write STDIN;
 EXPECT
-Filehandle main::STDIN opened only for input at - line 5.
+Filehandle STDIN opened only for input at - line 5.
 ########
 # pp_sys.c [pp_leavewrite]
 use warnings 'closed' ;
@@ -123,9 +123,9 @@ write STDIN;
 opendir STDIN, ".";
 write STDIN;
 EXPECT
-write() on closed filehandle main::STDIN at - line 6.
-write() on closed filehandle main::STDIN at - line 8.
-       (Are you trying to call write() on dirhandle main::STDIN?)
+write() on closed filehandle STDIN at - line 6.
+write() on closed filehandle STDIN at - line 8.
+       (Are you trying to call write() on dirhandle STDIN?)
 ########
 # pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
@@ -152,7 +152,7 @@ printf $a "fred";
 no warnings 'unopened' ;
 printf $a "fred";
 EXPECT
-Filehandle main::abc never opened at - line 4.
+Filehandle abc never opened at - line 4.
 ########
 # pp_sys.c [pp_prtf]
 use warnings 'closed' ;
@@ -166,9 +166,9 @@ printf STDIN "fred";
 opendir STDIN, ".";
 printf STDIN "fred";
 EXPECT
-printf() on closed filehandle main::STDIN at - line 4.
-printf() on closed filehandle main::STDIN at - line 6.
-       (Are you trying to call printf() on dirhandle main::STDIN?)
+printf() on closed filehandle STDIN at - line 4.
+printf() on closed filehandle STDIN at - line 6.
+       (Are you trying to call printf() on dirhandle STDIN?)
 ########
 # pp_sys.c [pp_prtf]
 use warnings 'io' ;
@@ -176,7 +176,7 @@ printf STDIN "fred";
 no warnings 'io' ;
 printf STDIN "fred";
 EXPECT
-Filehandle main::STDIN opened only for input at - line 3.
+Filehandle STDIN opened only for input at - line 3.
 ########
 # pp_sys.c [pp_send]
 use warnings 'closed' ;
@@ -190,9 +190,9 @@ syswrite STDIN, "fred", 1;
 opendir STDIN, ".";
 syswrite STDIN, "fred", 1;
 EXPECT
-syswrite() on closed filehandle main::STDIN at - line 4.
-syswrite() on closed filehandle main::STDIN at - line 6.
-       (Are you trying to call syswrite() on dirhandle main::STDIN?)
+syswrite() on closed filehandle STDIN at - line 4.
+syswrite() on closed filehandle STDIN at - line 6.
+       (Are you trying to call syswrite() on dirhandle STDIN?)
 ########
 # pp_sys.c [pp_flock]
 use Config; 
@@ -215,9 +215,9 @@ flock STDIN, 8;
 opendir STDIN, ".";
 flock STDIN, 8;
 EXPECT
-flock() on closed filehandle main::STDIN at - line 14.
-flock() on closed filehandle main::STDIN at - line 16.
-       (Are you trying to call flock() on dirhandle main::STDIN?)
+flock() on closed filehandle STDIN at - line 14.
+flock() on closed filehandle STDIN at - line 16.
+       (Are you trying to call flock() on dirhandle STDIN?)
 ########
 # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
 use warnings 'io' ;
@@ -285,36 +285,36 @@ getsockopt STDIN, 1,2;
 getsockname STDIN;
 getpeername STDIN;
 EXPECT
-send() on closed socket main::STDIN at - line 22.
-bind() on closed socket main::STDIN at - line 23.
-connect() on closed socket main::STDIN at - line 24.
-listen() on closed socket main::STDIN at - line 25.
-accept() on closed socket main::STDIN at - line 26.
-shutdown() on closed socket main::STDIN at - line 27.
-setsockopt() on closed socket main::STDIN at - line 28.
-getsockopt() on closed socket main::STDIN at - line 29.
-getsockname() on closed socket main::STDIN at - line 30.
-getpeername() on closed socket main::STDIN at - line 31.
-send() on closed socket main::STDIN at - line 33.
-       (Are you trying to call send() on dirhandle main::STDIN?)
-bind() on closed socket main::STDIN at - line 34.
-       (Are you trying to call bind() on dirhandle main::STDIN?)
-connect() on closed socket main::STDIN at - line 35.
-       (Are you trying to call connect() on dirhandle main::STDIN?)
-listen() on closed socket main::STDIN at - line 36.
-       (Are you trying to call listen() on dirhandle main::STDIN?)
-accept() on closed socket main::STDIN at - line 37.
-       (Are you trying to call accept() on dirhandle main::STDIN?)
-shutdown() on closed socket main::STDIN at - line 38.
-       (Are you trying to call shutdown() on dirhandle main::STDIN?)
-setsockopt() on closed socket main::STDIN at - line 39.
-       (Are you trying to call setsockopt() on dirhandle main::STDIN?)
-getsockopt() on closed socket main::STDIN at - line 40.
-       (Are you trying to call getsockopt() on dirhandle main::STDIN?)
-getsockname() on closed socket main::STDIN at - line 41.
-       (Are you trying to call getsockname() on dirhandle main::STDIN?)
-getpeername() on closed socket main::STDIN at - line 42.
-       (Are you trying to call getpeername() on dirhandle main::STDIN?)
+send() on closed socket STDIN at - line 22.
+bind() on closed socket STDIN at - line 23.
+connect() on closed socket STDIN at - line 24.
+listen() on closed socket STDIN at - line 25.
+accept() on closed socket STDIN at - line 26.
+shutdown() on closed socket STDIN at - line 27.
+setsockopt() on closed socket STDIN at - line 28.
+getsockopt() on closed socket STDIN at - line 29.
+getsockname() on closed socket STDIN at - line 30.
+getpeername() on closed socket STDIN at - line 31.
+send() on closed socket STDIN at - line 33.
+       (Are you trying to call send() on dirhandle STDIN?)
+bind() on closed socket STDIN at - line 34.
+       (Are you trying to call bind() on dirhandle STDIN?)
+connect() on closed socket STDIN at - line 35.
+       (Are you trying to call connect() on dirhandle STDIN?)
+listen() on closed socket STDIN at - line 36.
+       (Are you trying to call listen() on dirhandle STDIN?)
+accept() on closed socket STDIN at - line 37.
+       (Are you trying to call accept() on dirhandle STDIN?)
+shutdown() on closed socket STDIN at - line 38.
+       (Are you trying to call shutdown() on dirhandle STDIN?)
+setsockopt() on closed socket STDIN at - line 39.
+       (Are you trying to call setsockopt() on dirhandle STDIN?)
+getsockopt() on closed socket STDIN at - line 40.
+       (Are you trying to call getsockopt() on dirhandle STDIN?)
+getsockname() on closed socket STDIN at - line 41.
+       (Are you trying to call getsockname() on dirhandle STDIN?)
+getpeername() on closed socket STDIN at - line 42.
+       (Are you trying to call getpeername() on dirhandle STDIN?)
 ########
 # pp_sys.c [pp_stat]
 use warnings 'newline' ;
@@ -351,4 +351,4 @@ my $a = sysread(F, $a,10) ;
 close F ;
 unlink $file ;
 EXPECT
-Filehandle main::F opened only for output at - line 5.
+Filehandle F opened only for output at - line 5.

diff --git a/util.c b/util.c
index df6bbf5..897360c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3896,7 +3896,7 @@ Perl_report_closed_fh(pTHX_ GV *gv, IO *io, const char *func, const char *obj)
     assert(gv);
 
     sv = sv_newmortal();
-    gv_efullname3(sv, gv, Nullch);
+    gv_efullname4(sv, gv, Nullch, FALSE);
     name = SvPVX(sv);
 
     Perl_warner(aTHX_ WARN_CLOSED, "%s() on closed %s %s", func, obj, name);