Skip Menu |
Report information

Date: Wed, 29 Jan 2014 09:15:25 -0500 (EST)
CC: rjbs [...] cpan.org
From: rjbs [...] cpan.org
To: perlbug [...] perl.org
Subject: only warn about \n in failed file op if newline is trailing
Download (untitled) / with headers
text/plain 3.8k
This is a bug report for perl from rjbs@cpan.org, generated with the help of perlbug 1.39 running under perl 5.18.2. ----------------------------------------------------------------- [Please describe your issue here] After reading #121085, Peter Rabbitson noted that the "Unsuccessful %s on filename containing newline" is triggered even if the newline is within the middle of a string. If the problem we're guarding against is failure to chomp, we could only issue this warning at the end. If we think it's important to also protect against (say) bad input record separator or failure to split(), then we can update the docs, but I think that the failure to chomp is the bigger deal, and we could reduce false positives. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl 5.18.2: Configured by rjbs at Sun Dec 22 09:22:03 EST 2013. Summary of my perl5 (revision 5 version 18 subversion 2) configuration: Platform: osname=darwin, osvers=13.0.0, archname=darwin-2level uname='darwin walrus.local 13.0.0 darwin kernel version 13.0.0: thu sep 19 22:22:27 pdt 2013; root:xnu-2422.1.72~6release_x86_64 x86_64 ' config_args='-Dprefix=/Users/rjbs/.plenv/versions/18.2 -de -Dusedevel -A'eval:scriptdir=/Users/rjbs/.plenv/versions/18.2/bin'' hint=recommended, useposix=true, d_sigaction=define useithreads=undef, usemultiplicity=undef useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-fno-common -DPERL_DARWIN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include', optimize='-O3', cppflags='-fno-common -DPERL_DARWIN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -I/opt/local/include' ccversion='', gccversion='4.2.1 Compatible Apple LLVM 5.0 (clang-500.2.79)', gccosandvers='' intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16 ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -fstack-protector -L/usr/local/lib -L/opt/local/lib' libpth=/usr/local/lib /opt/local/lib /usr/lib libs=-lgdbm -ldbm -ldl -lm -lutil -lc perllibs=-ldl -lm -lutil -lc libc=, so=dylib, useshrplib=false, libperl=libperl.a gnulibc_version='' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib -L/opt/local/lib -fstack-protector' Locally applied patches: RC4 --- @INC for perl 5.18.2: /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2/darwin-2level /Users/rjbs/.plenv/versions/18.2/lib/perl5/site_perl/5.18.2 /Users/rjbs/.plenv/versions/18.2/lib/perl5/5.18.2/darwin-2level /Users/rjbs/.plenv/versions/18.2/lib/perl5/5.18.2 . --- Environment for perl 5.18.2: DYLD_LIBRARY_PATH (unset) HOME=/Users/rjbs LANG=en_US.UTF-8 LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/Users/rjbs/.plenv/versions/18.2/bin:/Users/rjbs/.plenv/libexec:/Users/rjbs/.plenv/plugins/perl-build/bin:/Users/rjbs/bin:/Users/rjbs/.rbenv/shims:/Users/rjbs/.rbenv/bin:/Users/rjbs/.plenv/shims:/Users/rjbs/.plenv/bin:/opt/local/bin:/opt/local/sbin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/opt/X11/bin:/Users/rjbs/bin:/Users/rjbs/.../bin:/Users/rjbs/code/hla PERLDOC=-n/opt/local/bin/groff PERL_AUTOINSTALL=--skipdeps PERL_BADLANG (unset) PERL_MAILERS=sendmail:/Users/rjbs/bin/sendmail SHELL=/opt/local/bin/zsh
To: Perl5 Porteros <perl5-porters [...] perl.org>
Subject: Re: [perl #121112] only warn about \n in failed file op if newline is trailing
CC: "bugs-bitbucket [...] rt.perl.org" <bugs-bitbucket [...] rt.perl.org>
From: demerphq <demerphq [...] gmail.com>
Date: Wed, 29 Jan 2014 23:20:52 +0800
Download (untitled) / with headers
text/plain 1.1k
On 29 January 2014 22:15, Ricardo SIGNES <perlbug-followup@perl.org> wrote: Show quoted text
> # New Ticket Created by Ricardo SIGNES > # Please include the string: [perl #121112] > # in the subject line of all future correspondence about this issue. > # <URL: https://rt.perl.org/Ticket/Display.html?id=121112 > > > > This is a bug report for perl from rjbs@cpan.org, > generated with the help of perlbug 1.39 running under perl 5.18.2. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > After reading #121085, Peter Rabbitson noted that the "Unsuccessful %s on > filename containing newline" is triggered even if the newline is within the > middle of a string. If the problem we're guarding against is failure to chomp, > we could only issue this warning at the end. > > If we think it's important to also protect against (say) bad input record > separator or failure to split(), then we can update the docs, but I think that > the failure to chomp is the bigger deal, and we could reduce false positives.
IMO as part of this ticket we should also figure out why perldiag says "PROBABLY". Yves
From: Paul Johnson <paul [...] pjcj.net>
CC: Perl5 Porteros <perl5-porters [...] perl.org>, "bugs-bitbucket [...] rt.perl.org" <bugs-bitbucket [...] rt.perl.org>
Subject: Re: [perl #121112] only warn about \n in failed file op if newline is trailing
To: demerphq <demerphq [...] gmail.com>
Date: Wed, 29 Jan 2014 16:37:17 +0100
Download (untitled) / with headers
text/plain 933b
On Wed, Jan 29, 2014 at 11:20:52PM +0800, demerphq wrote: Show quoted text
> IMO as part of this ticket we should also figure out why perldiag says > "PROBABLY".
Unsuccessful %s on filename containing newline (W newline) A file operation was attempted on a filename, and that operation failed, PROBABLY because the filename contained a newline, PROBABLY because you forgot to chomp() it off. See "chomp" in perlfunc. The reason the operation failed was probably because there is a newline in the filename and you wanted the filename without the newline. That might not be the reason; perhaps you forgot to create that file with the newline in its name. But probably not. And the reason you have a newline in the filename is probably because you forgot your chomp. That might not be the reason; you might have explicitly appended the newline. But probably not. -- Paul Johnson - paul@pjcj.net http://www.pjcj.net
Date: Wed, 29 Jan 2014 15:46:08 +0000
From: Smylers <Smylers [...] stripey.com>
To: perl5-porters [...] perl.org
Subject: Re: [perl #121112] only warn about \n in failed file op if newline is trailing
Download (untitled) / with headers
text/plain 962b
Paul Johnson writes: Show quoted text
> On Wed, Jan 29, 2014 at 11:20:52PM +0800, demerphq wrote: >
> > IMO as part of this ticket we should also figure out why perldiag says > > "PROBABLY".
> > Unsuccessful %s on filename containing newline > (W newline) A file operation was attempted on a filename, and that > operation failed, PROBABLY because the filename contained a > newline, PROBABLY because you forgot to chomp() it off. See > "chomp" in perlfunc. > > The reason the operation failed was probably because there is a > newline in the filename and you wanted the filename without the > newline.
As written, the message could reasonably be read to mean that it's probable that the filename contained a newline. If there's a way of phrasing it which succinctly conveys that the filename definitely contains (or ends in) "\n" and that's probably the problem, that would avoid anybody misreading it. Smylers -- http://twitter.com/Smylers2
From: Zefram <zefram [...] fysh.org>
Subject: Re: [perl #121112] only warn about \n in failed file op if newline is trailing
To: perl5-porters [...] perl.org
Date: Wed, 29 Jan 2014 16:06:44 +0000
Download (untitled) / with headers
text/plain 570b
Smylers wrote: Show quoted text
>As written, the message could reasonably be read to mean that it's >probable that the filename contained a newline.
True, it's not brilliantly clear. How about (W newline) A file operation was attempted using a filename that contains a newline, and that operation failed. It is likely that you forgot to chomp() the newline from an input line that contained the filename, and that the failure is due to using this incorrect version of the filename. See L<perlfunc/chomp>. Replace "contains" with "ends with" when the code is changed. -zefram
Date: Thu, 30 Jan 2014 00:21:53 +0800
From: demerphq <demerphq [...] gmail.com>
CC: Perl5 Porteros <perl5-porters [...] perl.org>
Subject: Re: [perl #121112] only warn about \n in failed file op if newline is trailing
To: Zefram <zefram [...] fysh.org>
Download (untitled) / with headers
text/plain 978b
On 30 January 2014 00:06, Zefram <zefram@fysh.org> wrote: Show quoted text
> Smylers wrote:
>>As written, the message could reasonably be read to mean that it's >>probable that the filename contained a newline.
> > True, it's not brilliantly clear. How about > > (W newline) A file operation was attempted using a filename that > contains a newline, and that operation failed. It is likely > that you forgot to chomp() the newline from an input line that > contained the filename, and that the failure is due to using > this incorrect version of the filename. See L<perlfunc/chomp>. > > Replace "contains" with "ends with" when the code is changed.
Im not convinced the code needs to change. Someone reading a list of filename with \r\n line endings that has one without the \r would end up with an \n in the middle of the "name". IMO that is the same thing as the warning tries to trap. Yves -- perl -Mre=debug -e "/just|another|perl|hacker/"
Date: Wed, 29 Jan 2014 16:24:43 +0000
Subject: Re: [perl #121112] only warn about \n in failed file op if newline is trailing
To: Perl5 Porteros <perl5-porters [...] perl.org>
From: Zefram <zefram [...] fysh.org>
Download (untitled) / with headers
text/plain 355b
demerphq wrote: Show quoted text
>Im not convinced the code needs to change. Someone reading a list of >filename with \r\n line endings that has one without the \r would end >up with an \n in the middle of the "name". IMO that is the same thing >as the warning tries to trap.
That sounds quite different from failure to chomp, and doesn't seem worth detecting. -zefram
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 657b
On Wed Jan 29 06:15:51 2014, rjbs wrote: Show quoted text
> After reading #121085, Peter Rabbitson noted that the "Unsuccessful %s > on > filename containing newline" is triggered even if the newline is > within the > middle of a string. If the problem we're guarding against is failure > to chomp, > we could only issue this warning at the end. > > If we think it's important to also protect against (say) bad input > record > separator or failure to split(), then we can update the docs, but I > think that > the failure to chomp is the bigger deal, and we could reduce false > positives.
The attached should do it, though I was pretty tired while I was doing it. Tony
Subject: 0001-perl-121112-only-warn-if-newline-is-the-last-non-NUL.patch
From 81284cd7f3542b39bde6b7a30235c9d4f72c94a4 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Fri, 21 Feb 2014 16:49:54 +1100 Subject: [PATCH] [perl #121112] only warn if newline is the last non-NUL character --- doio.c | 6 +++--- embed.fnc | 1 + embed.h | 1 + inline.h | 32 ++++++++++++++++++++++++++++++++ pp_sys.c | 19 ++++++++++--------- proto.h | 6 ++++++ t/lib/warnings/7fatal | 9 ++++++--- t/lib/warnings/doio | 23 +++++++++++++++++++---- t/lib/warnings/pp_sys | 14 ++++++++++++-- 9 files changed, 90 insertions(+), 21 deletions(-) diff --git a/doio.c b/doio.c index 81abd9c..0512f3e 100644 --- a/doio.c +++ b/doio.c @@ -535,7 +535,7 @@ Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw, } if (!fp) { if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE) - && strchr(oname, '\n') + && should_warn_nl(oname) ) { @@ -1321,7 +1321,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; @@ -1384,7 +1384,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; diff --git a/embed.fnc b/embed.fnc index f747aae..4a6f529 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1628,6 +1628,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 2f8aca5..c96ce74 100644 --- a/embed.h +++ b/embed.h @@ -1240,6 +1240,7 @@ #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) diff --git a/inline.h b/inline.h index 518d8da..86e005d 100644 --- 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 diff --git a/pp_sys.c b/pp_sys.c index 6c4e2c7..66f43e6 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2785,6 +2785,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) @@ -2796,14 +2797,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"); @@ -3340,17 +3340,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 e032ad6..84952ea 100644 --- a/proto.h +++ b/proto.h @@ -3837,6 +3837,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 \ diff --git a/t/lib/warnings/7fatal b/t/lib/warnings/7fatal index 32d2f19..aab7fd1 100644 --- a/t/lib/warnings/7fatal +++ b/t/lib/warnings/7fatal @@ -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 diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio index bf0cd78..862b821 100644 --- a/t/lib/warnings/doio +++ b/t/lib/warnings/doio @@ -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'; diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index 0891a39..a4f4aba 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -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' ; -- 1.7.10.4
From: Ricardo Signes <perl.p5p [...] rjbs.manxome.org>
To: perl5-porters [...] perl.org
Date: Wed, 26 Feb 2014 18:35:21 -0500
Subject: Re: [perl #121112] only warn about \n in failed file op if newline is trailing
Download (untitled) / with headers
text/plain 212b
* Tony Cook via RT <perlbug-followup@perl.org> [2014-02-21T00:51:12] Show quoted text
> The attached should do it, though I was pretty tired while I was doing it.
Somebody care to review this patch and give it a ±1? -- rjbs
Download signature.asc
application/pgp-signature 473b

Message body not shown because it is not plain text.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 553b
On Wed Feb 26 15:35:55 2014, perl.p5p@rjbs.manxome.org wrote: Show quoted text
> * Tony Cook via RT <perlbug-followup@perl.org> [2014-02-21T00:51:12]
> > The attached should do it, though I was pretty tired while I was doing it.
> > Somebody care to review this patch and give it a ±1? > >
I can't evaluate the C code. The tests appear satisfactory, though the lack of descriptions on 825 or 837 individual tests in lib/warnings.t impedes closer analysis. I wrote my own test file which appears to DWIM once the patch is applied. Thank you very much. Jim Keenan
RT-Send-CC: perl5-porters [...] perl.org
This was not applied before freeze for 5.20.0. I have marked it as a 5.21.1 blocker. -- rjbs
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 217b
On Thu Feb 20 21:51:12 2014, tonyc wrote: Show quoted text
> The attached should do it, though I was pretty tired while I was doing it.
Fails to apply due to a6fc70e55b0240c99a09f1d7185e5c59ffd57206. Attached an updated patch. Tony
Subject: 0001-perl-121112-only-warn-if-newline-is-the-last-non-NUL.patch
From 053e70a2a951364565e29371b4d693f11d7e6718 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 12 May 2014 13:55:36 +1000 Subject: [perl #121112] only warn if newline is the last non-NUL character --- doio.c | 6 +++--- embed.fnc | 1 + embed.h | 1 + inline.h | 32 ++++++++++++++++++++++++++++++++ pp_sys.c | 19 ++++++++++--------- proto.h | 6 ++++++ t/lib/warnings/7fatal | 9 ++++++--- t/lib/warnings/doio | 23 +++++++++++++++++++---- t/lib/warnings/pp_sys | 14 ++++++++++++-- 9 files changed, 90 insertions(+), 21 deletions(-) diff --git a/doio.c b/doio.c index e2bfda5..c868b29 100644 --- 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; diff --git a/embed.fnc b/embed.fnc index 1545bd2..834acc6 100644 --- 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 d4b1752..ee07d15 100644 --- a/embed.h +++ b/embed.h @@ -1242,6 +1242,7 @@ #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) diff --git a/inline.h b/inline.h index 518d8da..86e005d 100644 --- 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 diff --git a/pp_sys.c b/pp_sys.c index 9f97177..0541a72 100644 --- 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 a553202..529edfd 100644 --- 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 \ diff --git a/t/lib/warnings/7fatal b/t/lib/warnings/7fatal index 32d2f19..aab7fd1 100644 --- a/t/lib/warnings/7fatal +++ b/t/lib/warnings/7fatal @@ -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 diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio index 63250e1..baa6b97 100644 --- a/t/lib/warnings/doio +++ b/t/lib/warnings/doio @@ -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'; diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index 0891a39..a4f4aba 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -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' ; -- 1.7.10.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 326b
On Sun May 11 20:58:55 2014, tonyc wrote: Show quoted text
> On Thu Feb 20 21:51:12 2014, tonyc wrote:
> > The attached should do it, though I was pretty tired while I was doing it.
> > Fails to apply due to a6fc70e55b0240c99a09f1d7185e5c59ffd57206. > > Attached an updated patch.
Applied as 7cb3f9598b37fcd8b30ea273d668c8b48d5f4c76. Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org