warn on ref open without perlio

Message-ID: <20020418231744.A24159@rafael>

(with one nit, the skip message needed "# " prefix)

p4raw-id: //depot/perl@16004

diff --git a/doio.c b/doio.c
index 1495ff5..d362cb9 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -213,6 +213,15 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (num_svs) {
            /* New style explict name, type is just mode and discipline/layer info */
            STRLEN l = 0;
+#ifdef USE_STDIO
+           if (SvROK(*svp) && !strchr(name,'&')) {
+               if (ckWARN(WARN_IO))
+                   Perl_warner(aTHX_ packWARN(WARN_IO),
+                           "Can't open a reference");
+               SETERRNO(EINVAL, LIB$_INVARG);
+               goto say_false;
+           }
+#endif /* USE_STDIO */
            name = SvOK(*svp) ? SvPV(*svp, l) : "";
            len = (I32)l;
            name = savepvn(name, len);

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f22aa80..c10aa0e 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -862,6 +862,16 @@ switches, or explicitly, failed for the indicated reason.  Usually this
 is because you don't have read permission for a file which you named on
 the command line.
 
+=item Can't open a reference
+
+(W io) You tried to open a scalar reference for reading or writing,
+using the 3-arg open() syntax :
+
+    open FH, '>', $ref;
+
+but your version of perl is compiled without perlio, and this form of
+open is not supported.
+
 =item Can't open bidirectional pipe
 
 (W pipe) You tried to say C<open(CMD, "|cmd|")>, which is not supported.

diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index 0db1a13..db57195 100644 (file)
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@@ -228,3 +228,22 @@ no warnings 'io' ;
 $a = eof STDOUT ;
 EXPECT
 Filehandle STDOUT opened only for output at - line 3.
+########
+# doio.c [Perl_do_openn]
+use Config;
+BEGIN {
+    if ($Config{useperlio}) {
+       print <<EOM;
+SKIPPED
+# warns only without perlio
+EOM
+       exit;
+    }
+}
+use warnings 'io';
+my $x = "foo";
+open FOO, '>', \$x;
+no warnings 'io';
+open FOO, '>', \$x;
+EXPECT
+Can't open a reference at - line 14.