Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.96k stars 556 forks source link

[PATCH] Spaces in a prototype can throw off the parser #13057

Closed p5pRT closed 11 years ago

p5pRT commented 11 years ago

Migrated from rt.perl.org#118623 (status was 'resolved')

Searchable as RT118623$

p5pRT commented 11 years ago

From PeterCMartini@GMail.com

This is a bug report for perl from petercmartini@​gmail.com -----------------------------------------------------------------

When a prototype is declared inline\, like sub foo( $ $ )\, the extra spaces are removed before the prototype '$$' is attached. Other places in the core that actually handle prototypes assume spaces have already been stripped\, which can lead to subtle bugs\, such as​:

perl -MScalar​::Util=set_prototype -e 'sub foo{} BEGIN { set_prototype \&foo\, " \$ "; } foo 1;' Not enough arguments for main​::foo at -e line 1\, near "1;" Execution of -e aborted due to compilation errors.

Patch attached. I opted to modify a copy of the prototype instead of the prototype directly on the theory that if someone took the time to add extra whitespace\, we'll leave it there for them.

Perl Info ``` Flags: category=core severity=low Site configuration information for perl 5.19.1: Configured by pmartini at Fri Jan 25 00:20:08 EST 2013. Summary of my perl5 (revision 5 version 19 subversion 1) configuration: Derived from: d63fe723ea255085c368fd588fcc40df0120cec2 Platform: osname=linux, osvers=3.2.0-38-generic, archname=i686-linux-thread-multi uname='linux pmlinlaptop 3.2.0-38-generic #61-ubuntu smp tue feb 19 12:20:02 utc 2013 i686 i686 i386 gnulinux ' config_args='-DDEBUGGING -Dusedevel -Dusethreads -des' hint=recommended, useposix=true, d_sigaction=define useithreads=define, usemultiplicity=define useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2 -g', cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.6.3', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=4, prototype=define Linker and Libraries: ld='cc', ldflags =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /lib/i386-linux-gnu /lib/../lib /usr/lib/i386-linux-gnu /usr/lib/../lib /lib /usr/lib libs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc libc=, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.15' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib -fstack-protector' Characteristics of this binary (from libperl): Compile-time options: DEBUGGING HAS_TIMES MULTIPLICITY PERLIO_LAYERS PERL_DONT_CREATE_GVSV PERL_HASH_FUNC_ONE_AT_A_TIME_HARD PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP PERL_NEW_COPY_ON_WRITE PERL_PRESERVE_IVUV PERL_TRACK_MEMPOOL PERL_USE_DEVEL USE_ITHREADS USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_PERLIO USE_PERL_ATOF USE_REENTRANT_API Locally applied patches: uncommitted-changes Built under linux Compiled at Jun 17 2013 15:59:30 %ENV: PERL5LIB="/home/pmartini/perl5/lib/perl5:" PERL_LOCAL_LIB_ROOT=":/home/pmartini/perl5" PERL_MB_OPT="--install_base /home/pmartini/perl5" PERL_MM_OPT="INSTALL_BASE=/home/pmartini/perl5" @INC: lib /home/pmartini/perl5/lib/perl5/i686-linux-thread-multi /home/pmartini/perl5/lib/perl5 /usr/local/lib/perl5/site_perl/5.19.1/i686-linux-thread-multi /usr/local/lib/perl5/site_perl/5.19.1 /usr/local/lib/perl5/5.19.1/i686-linux-thread-multi /usr/local/lib/perl5/5.19.1 /usr/local/lib/perl5/site_perl . ```
p5pRT commented 11 years ago

From PeterCMartini@GMail.com

0001-Remove-spaces-from-a-copy-of-a-proto-when-used.patch ```diff From 9761220438cbbb3a010d3a39cc06b4d8d3b33237 Mon Sep 17 00:00:00 2001 From: Peter Martini Date: Mon, 24 Jun 2013 17:58:46 -0400 Subject: [PATCH] Remove spaces from a (copy of) a proto when used. The logic that uses prototypes assumes spaces were already gone, which may not be true if they were added via XS / set_prototype. --- inline.h | 28 ++++++++++++++++++++++++++++ op.c | 2 ++ toke.c | 1 + 3 files changed, 31 insertions(+) diff --git a/inline.h b/inline.h index 29a15ac..00c59f5 100644 --- a/inline.h +++ b/inline.h @@ -32,6 +32,34 @@ S_CvDEPTHp(const CV * const sv) return &((XPVCV*)SvANY(sv))->xcv_depth; } +/* + CvPROTO returns the prototype as stored, which is not necessarily what + the interpreter should be using. Specifically, the interpreter assumes + that spaces have been stripped, which has been the case if the prototype + was added by toke.c, but is generally not the case if it was added elsewhere. + Since we can't enforce the spacelessness at assignment time, this routine + provides a temporary copy at parse time with spaces removed. + I is the start of the original buffer, I is the length of the + prototype and will be updated when this returns. + */ + +PERL_STATIC_INLINE char * +S_strip_spaces(pTHX_ const char * orig, STRLEN * const len) +{ + SV * tmpsv; + char * tmps; + tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP); + tmps = SvPVX(tmpsv); + while ((*len)--) { + if (!isSPACE(*orig)) + *tmps++ = *orig; + orig++; + } + *tmps = '\0'; + *len = tmps - SvPVX(tmpsv); + return SvPVX(tmpsv); +} + /* ----------------------------- regexp.h ----------------------------- */ PERL_STATIC_INLINE struct regexp * diff --git a/op.c b/op.c index 18b065c..ecf16dd 100644 --- a/op.c +++ b/op.c @@ -10078,6 +10078,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) if (SvTYPE(protosv) == SVt_PVCV) proto = CvPROTO(protosv), proto_len = CvPROTOLEN(protosv); else proto = SvPV(protosv, proto_len); + proto = S_strip_spaces(aTHX_ proto, &proto_len); proto_end = proto + proto_len; aop = cUNOPx(entersubop)->op_first; if (!aop->op_sibling) diff --git a/toke.c b/toke.c index 3493c5b..0612011 100644 --- a/toke.c +++ b/toke.c @@ -7281,6 +7281,7 @@ Perl_yylex(pTHX) STRLEN protolen = CvPROTOLEN(cv); const char *proto = CvPROTO(cv); bool optional; + proto = S_strip_spaces(aTHX_ proto, &protolen); if (!protolen) TERM(FUNC0SUB); if ((optional = *proto == ';')) -- 1.7.9.5 ```
p5pRT commented 11 years ago

From @tonycoz

On Mon Jun 24 15​:19​:41 2013\, pcm wrote​:

When a prototype is declared inline\, like sub foo( $ $ )\, the extra spaces are removed before the prototype '$$' is attached. Other places in the core that actually handle prototypes assume spaces have already been stripped\, which can lead to subtle bugs\, such as​:

perl -MScalar​::Util=set_prototype -e 'sub foo{} BEGIN { set_prototype \&foo\, " \$ "; } foo 1;' Not enough arguments for main​::foo at -e line 1\, near "1;" Execution of -e aborted due to compilation errors.

Patch attached. I opted to modify a copy of the prototype instead of the prototype directly on the theory that if someone took the time to add extra whitespace\, we'll leave it there for them.

Thanks\, applied as d16269d8356f921e8939320f5cfd7d08d130c078.

Tony

p5pRT commented 11 years ago

The RT System itself - Status changed from 'new' to 'open'

p5pRT commented 11 years ago

@tonycoz - Status changed from 'open' to 'resolved'