This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #121112] only warn if newline is the last non-NUL character
authorTony Cook <tony@develop-help.com>
Mon, 12 May 2014 03:55:36 +0000 (13:55 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 28 May 2014 00:31:12 +0000 (10:31 +1000)
doio.c
embed.fnc
embed.h
inline.h
pp_sys.c
proto.h
t/lib/warnings/7fatal
t/lib/warnings/doio
t/lib/warnings/pp_sys

diff --git a/doio.c b/doio.c
index e2bfda5..c868b29 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -617,7 +617,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
 
     if (!fp) {
        if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
-           && strchr(oname, '\n')
+           && should_warn_nl(oname)
            
        )
         {
@@ -1407,7 +1407,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
        s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
        PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_stat(s, &PL_statcache);
-       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n')) {
+       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) {
             GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
             GCC_DIAG_RESTORE;
@@ -1470,7 +1470,7 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
     file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n')) {
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
         GCC_DIAG_IGNORE(-Wformat-nonliteral); /* PL_warn_nl is constant */
         Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
         GCC_DIAG_RESTORE;
index c78f345..fc3ed95 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1643,6 +1643,7 @@ Ap     |I32    |whichsig_pv    |NN const char* sig
 Ap     |I32    |whichsig_pvn   |NN const char* sig|STRLEN len
 : used to check for NULs in pathnames and other names
 AiR    |bool   |is_safe_syscall|NN const char *pv|STRLEN len|NN const char *what|NN const char *op_name
+inR    |bool   |should_warn_nl|NN const char *pv
 : Used in pp_ctl.c
 p      |void   |write_to_stderr|NN SV* msv
 : Used in op.c
diff --git a/embed.h b/embed.h
index a6e3b9d..b7a0290 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define scalar(a)              Perl_scalar(aTHX_ a)
 #define scalarvoid(a)          Perl_scalarvoid(aTHX_ a)
 #define set_caret_X()          Perl_set_caret_X(aTHX)
+#define should_warn_nl         S_should_warn_nl
 #define sub_crush_depth(a)     Perl_sub_crush_depth(aTHX_ a)
 #define sv_2num(a)             Perl_sv_2num(aTHX_ a)
 #define sv_clean_all()         Perl_sv_clean_all(aTHX)
index 518d8da..86e005d 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -323,6 +323,38 @@ S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char
 }
 
 /*
+
+Return true if the supplied filename has a newline character
+immediately before the final NUL.
+
+My original look at this incorrectly used the len from SvPV(), but
+that's incorrect, since we allow for a NUL in pv[len-1].
+
+So instead, strlen() and work from there.
+
+This allow for the user reading a filename, forgetting to chomp it,
+then calling:
+
+  open my $foo, "$file\0";
+
+*/
+
+#ifdef PERL_CORE
+
+PERL_STATIC_INLINE bool
+S_should_warn_nl(const char *pv) {
+    STRLEN len;
+
+    PERL_ARGS_ASSERT_SHOULD_WARN_NL;
+
+    len = strlen(pv);
+
+    return len > 0 && pv[len-1] == '\n';
+}
+
+#endif
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
index 9f97177..0541a72 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2784,6 +2784,7 @@ PP(pp_stat)
        }
     }
     else {
+        const char *file;
        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { 
             io = MUTABLE_IO(SvRV(sv));
             if (PL_op->op_type == OP_LSTAT)
@@ -2795,14 +2796,13 @@ PP(pp_stat)
        sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
        PL_statgv = NULL;
        PL_laststype = PL_op->op_type;
+        file = SvPV_nolen_const(PL_statname);
        if (PL_op->op_type == OP_LSTAT)
-           PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
+           PL_laststatval = PerlLIO_lstat(file, &PL_statcache);
        else
-           PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
+           PL_laststatval = PerlLIO_stat(file, &PL_statcache);
        if (PL_laststatval < 0) {
-           if (ckWARN(WARN_NEWLINE) &&
-                    strchr(SvPV_nolen_const(PL_statname), '\n'))
-            {
+           if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
                 /* PL_warn_nl is constant */
                 GCC_DIAG_IGNORE(-Wformat-nonliteral);
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
@@ -3339,17 +3339,18 @@ PP(pp_fttext)
        }
     }
     else {
+        const char *file;
+
        sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
       really_filename:
+        file = SvPVX_const(PL_statname);
        PL_statgv = NULL;
-       if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
+       if (!(fp = PerlIO_open(file, "r"))) {
            if (!gv) {
                PL_laststatval = -1;
                PL_laststype = OP_STAT;
            }
-           if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
-                                              '\n'))
-            {
+           if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) {
                 /* PL_warn_nl is constant */
                 GCC_DIAG_IGNORE(-Wformat-nonliteral);
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
diff --git a/proto.h b/proto.h
index a6ee09a..f7716b5 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3849,6 +3849,12 @@ PERL_CALLCONV HEK*       Perl_share_hek(pTHX_ const char* str, I32 len, U32 hash)
 #define PERL_ARGS_ASSERT_SHARE_HEK     \
        assert(str)
 
+PERL_STATIC_INLINE bool        S_should_warn_nl(const char *pv)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_SHOULD_WARN_NL        \
+       assert(pv)
+
 PERL_CALLCONV void     Perl_sortsv(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t cmp)
                        __attribute__nonnull__(pTHX_3);
 #define PERL_ARGS_ASSERT_SORTSV        \
index 32d2f19..aab7fd1 100644 (file)
@@ -416,18 +416,21 @@ use warnings FATAL => 'all', NONFATAL => 'io';
 no warnings 'once';
 
 open(F, "<true\ncd");
+open(G, "<truecd\n");
+open(H, "<truecd\n\0");
 close "fred" ;
 print STDERR "The End.\n" ;
 EXPECT
-Unsuccessful open on filename containing newline at - line 5.
-close() on unopened filehandle fred at - line 6.
+Unsuccessful open on filename containing newline at - line 6.
+Unsuccessful open on filename containing newline at - line 7.
+close() on unopened filehandle fred at - line 8.
 The End.
 ########
 
 use warnings FATAL => 'all', NONFATAL => 'io', FATAL => 'unopened' ;
 no warnings 'once';
 
-open(F, "<true\ncd");
+open(F, "<truecd\n");
 close "fred" ;
 print STDERR "The End.\n" ;
 EXPECT
index 63250e1..baa6b97 100644 (file)
@@ -87,10 +87,15 @@ Missing command in piped open at - line 3.
 # doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, "<true\ncd");
+open(G, "<truecd\n");
+open(H, "<truecd\n\0");
 no warnings 'io' ;
-open(G, "<true\ncd");
+open(H, "<true\ncd");
+open(I, "<truecd\n");
+open(I, "<truecd\n\0");
 EXPECT
-Unsuccessful open on filename containing newline at - line 3.
+Unsuccessful open on filename containing newline at - line 4.
+Unsuccessful open on filename containing newline at - line 5.
 ########
 # doio.c [Perl_do_close] <<TODO
 use warnings 'unopened' ;
@@ -149,12 +154,22 @@ Use of uninitialized value $a in print at - line 3.
 use warnings 'io' ;
 stat "ab\ncd";
 lstat "ab\ncd";
+stat "abcd\n";
+lstat "abcd\n";
+stat "abcd\n\0";
+lstat "abcd\n\0";
 no warnings 'io' ;
 stat "ab\ncd";
 lstat "ab\ncd";
+stat "abcd\n";
+lstat "abcd\n";
+stat "abcd\n\0";
+lstat "abcd\n\0";
 EXPECT
-Unsuccessful stat on filename containing newline at - line 3.
-Unsuccessful stat on filename containing newline at - line 4.
+Unsuccessful stat on filename containing newline at - line 5.
+Unsuccessful stat on filename containing newline at - line 6.
+Unsuccessful stat on filename containing newline at - line 7.
+Unsuccessful stat on filename containing newline at - line 8.
 ########
 # doio.c [Perl_my_stat]
 use warnings 'io';
index 0891a39..a4f4aba 100644 (file)
@@ -572,10 +572,15 @@ getpeername() on unopened socket FOO at - line 64.
 # pp_sys.c [pp_stat]
 use warnings 'newline' ;
 stat "abc\ndef";
+stat "abcdef\n";
+stat "abcdef\n\0";
 no warnings 'newline' ;
 stat "abc\ndef";
+stat "abcdef\n";
+stat "abcdef\n\0";
 EXPECT
-Unsuccessful stat on filename containing newline at - line 3.
+Unsuccessful stat on filename containing newline at - line 4.
+Unsuccessful stat on filename containing newline at - line 5.
 ########
 # pp_sys.c [pp_fttext]
 use warnings qw(unopened closed) ;
@@ -603,10 +608,15 @@ stat() on unopened filehandle foo at - line 9.
 # pp_sys.c [pp_fttext]
 use warnings 'newline' ;
 -T "abc\ndef" ;
+-T "abcdef\n" ;
+-T "abcdef\n\0" ;
 no warnings 'newline' ;
 -T "abc\ndef" ;
+-T "abcdef\n" ;
+-T "abcdef\n\0" ;
 EXPECT
-Unsuccessful open on filename containing newline at - line 3.
+Unsuccessful open on filename containing newline at - line 4.
+Unsuccessful open on filename containing newline at - line 5.
 ########
 # pp_sys.c [pp_sysread]
 use warnings 'io' ;