Skip Menu |
Report information
Id: 121048
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: brian.carpenter [at] gmail.com
dcollinsn [at] gmail.com
zefram [at] fysh.org
Cc:
AdminCc:

Operating System: Linux
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.19.7
Fixed In: 5.22.1

Attachments
0001-add-panic-wrong-function-prototype-for-funcname.patch
0001-perl-125341-check-for-unexpected-trash-after-any-sub.patch



Date: Tue, 21 Jan 2014 20:51:39 +0000
CC: zefram [...] fysh.org
From: zefram [...] fysh.org
To: perlbug [...] perl.org
Subject: illegal sub declaration crashes
Download (untitled) / with headers
text/plain 3.9k
This is a bug report for perl from zefram@fysh.org, generated with the help of perlbug 1.39 running under perl 5.19.7. ----------------------------------------------------------------- [Please describe your issue here] $ perl -lwe 'BEGIN <> { }' Use of uninitialized value at -e line 1. zsh: segmentation fault perl -lwe 'BEGIN <> { }' This takes a funny path through the tokeniser. "BEGIN" and a few other keywords get treated as if "sub" had been said first. The "sub" handler has an explicit check for unexpected stuff preceding the body: $ perl -lwe 'sub BEGIN <> { }' Illegal declaration of subroutine main::BEGIN at -e line 1. But the "sub" handler doesn't apply this check if the "sub" keyword wasn't really there. I haven't looked into what actually makes this crash. In theory the check should be entirely redundant: if the next token isn't one of the permitted ones then a simple syntax error should result. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl 5.19.7: Configured by zefram at Mon Dec 23 19:18:49 GMT 2013. Summary of my perl5 (revision 5 version 19 subversion 7) configuration: Platform: osname=linux, osvers=3.2.0-4-amd64, archname=x86_64-linux-thread-multi uname='linux barba.rous.org 3.2.0-4-amd64 #1 smp debian 3.2.46-1 x86_64 gnulinux ' config_args='-des -Dprefix=/home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52 -Duselargefiles -Dusethreads -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dusedevel -Uversiononly -Ui_db' hint=recommended, useposix=true, d_sigaction=define useithreads=define, usemultiplicity=define useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2', cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.7.2', 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='cc', ldflags =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lpthread -lc perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc libc=, so=so, useshrplib=true, libperl=libperl.so gnulibc_version='2.15' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/5.19.7/x86_64-linux-thread-multi/CORE' cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector' --- @INC for perl 5.19.7: /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/site_perl/5.19.7/x86_64-linux-thread-multi /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/site_perl/5.19.7 /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/5.19.7/x86_64-linux-thread-multi /home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/lib/5.19.7 . --- Environment for perl 5.19.7: HOME=/home/zefram LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/home/zefram/usr/perl/perl_install/perl-5.19.7-i64-f52/bin:/home/zefram/usr/perl/util:/home/zefram/pub/x86_64-unknown-linux-gnu/bin:/home/zefram/pub/common/bin:/usr/bin:/bin:/usr/local/bin:/usr/games PERL_BADLANG (unset) SHELL=/usr/bin/zsh
Subject: Perl_newATTRSUB_x: Assertion `proto->op_type == OP_CONST' failed (op.c:8458)
Download (untitled) / with headers
text/plain 2.6k
The following "script" causes two behaviors to manifest in two different versions of Perl. perl -e 'BEGIN<>' 1st, in Perl 5.23.0 (v5.22.0-63-g216b41c), it causes Perl_newATTRSUB_x: Assertion `proto->op_type == OP_CONST' failed at op.c:8458. 2nd, in Perl 5.21.6-602-ge9d2bd8, it causes a segfault at Perl_op_free (op.c:757). ==34585== Invalid read of size 2 ==34585== at 0x43D368: Perl_op_free (op.c:757) ==34585== by 0x8B93D7: Perl_leave_scope (scope.c:986) ==34585== by 0x4AD9F6: Perl_newATTRSUB_x (op.c:8870) ==34585== by 0x5CD38A: Perl_yyparse (perly.y:294) ==34585== by 0x4F0874: perl_parse (perl.c:2271) ==34585== by 0x42A87B: main (perlmain.c:114) ==34585== Address 0x300000020 is not stack'd, malloc'd or (recently) free'd ==34585== ==34585== ==34585== Process terminating with default action of signal 11 (SIGSEGV) ==34585== Access not within mapped region at address 0x300000020 ==34585== at 0x43D368: Perl_op_free (op.c:757) ==34585== by 0x8B93D7: Perl_leave_scope (scope.c:986) ==34585== by 0x4AD9F6: Perl_newATTRSUB_x (op.c:8870) ==34585== by 0x5CD38A: Perl_yyparse (perly.y:294) ==34585== by 0x4F0874: perl_parse (perl.c:2271) ==34585== by 0x42A87B: main (perlmain.c:114) ==34585== If you believe this happened as a result of a stack ==34585== overflow in your program's main thread (unlikely but ==34585== possible), you can try to increase the size of the ==34585== main thread stack using the --main-stacksize= flag. ==34585== The main thread stack size used in this run was 8388608. Program received signal SIGSEGV, Segmentation fault. Perl_op_free (o=0xe46898) at op.c:757 757 op.c: No such file or directory. (gdb) bt #0 Perl_op_free (o=0xe46898) at op.c:757 #1 0x00000000008b93d8 in Perl_leave_scope (base=39) at scope.c:986 #2 0x00000000004ad9f7 in Perl_newATTRSUB_x (floor=39, o=<optimized out>, proto=0xe46898, attrs=0x0, block=<optimized out>, o_is_gv=<optimized out>) at op.c:8870 #3 0x00000000005cd38b in Perl_yyparse (gramtype=<optimized out>) at perly.y:294 #4 0x00000000004f0875 in S_parse_body (xsinit=0x42ac70 <xs_init>, env=0x0) at perl.c:2271 #5 perl_parse (my_perl=<optimized out>, xsinit=0x42ac70 <xs_init>, argc=<optimized out>, argv=<optimized out>, env=0x0) at perl.c:1605 #6 0x000000000042a87c in main (argc=2, argv=0x7fffffffe3a8, env=0x7fffffffe3c0) at perlmain.c:114 #7 0x00007ffff6f98ead in __libc_start_main (main=<optimized out>, argc=<optimized out>, ubp_av=<optimized out>, init=<optimized out>, fini=<optimized out>, rtld_fini=<optimized out>, stack_end=0x7fffffffe398) at libc-start.c:244 #8 0x000000000042ab95 in _start ()
Subject: Perl segfaults while handling a syntax error, appears to be reusing an OP as an SV
Download (untitled) / with headers
text/plain 11.5k
Greetings, While experimenting with the afl-gcc fuzzing utility, I located a very simple test case that causes perl to segfault without printing any errors: $ perl ../test1.pl Segmentation fault (core dumped) $ perl -w ../test1.pl Use of uninitialized value at ../test1.pl line 1. Segmentation fault (core dumped) The testcase reads as follows: $ od -c ../test1.pl 0000000 B E G I N < > \n 0000010 NB: The newline is not strictly required to reproduce and is a consequence of me starting to debug this on one computer, and finishing on a different computer. I didn't realize the newline was there, but since it appears in the backtrace below, I didn't want to confuse you by removing it. This is reproducible with perls at least as old as 5.14.4 through blead, and miniperl fails in the same manner. The segfault occurs in Perl_op_free, when attempting to free the sibling of the child of an OP, as evidenced below. Here is the stack trace for the segfault: #0 0x000000010040c171 in Perl_op_free (o=0x600077a78) at op.c:761 #1 0x00000001005229de in Perl_leave_scope (base=39) at scope.c:986 #2 0x0000000100421331 in Perl_newATTRSUB_x (floor=39, o=0x6000777c8, proto=0x600077a78, attrs=0x0, block=0x0, o_is_gv=false) at op.c:8828 #3 0x000000010046a20f in Perl_yyparse (gramtype=258) at perly.y:294 #4 0x0000000100404538 in S_parse_body (env=0x0, xsinit=0x10042f9e9 <xs_init>) at perl.c:2296 #5 0x00000001004036d5 in perl_parse (my_perl=0x60003ab40, xsinit=0x10042f9e9 <xs_init>, argc=2, argv=0x22aac0, env=0x0) at perl.c:1626 #6 0x000000010042f93b in main (argc=2, argv=0x22aac0, env=0x6000281a0) at miniperlmain.c:120 (gdb) l op.c:761 756 CALL_OPFREEHOOK(o); 757 758 if (o->op_flags & OPf_KIDS) { 759 OP *kid, *nextkid; 760 for (kid = cUNOPo->op_first; kid; kid = nextkid) { 761 nextkid = OpSIBLING(kid); /* Get before next freeing kid */ 762 if (!kid || kid->op_type == OP_FREED) 763 /* During the forced freeing of ops after 764 compilation failure, kidops may be freed before 765 their parents. */ It appears that Perl_op_free is being called on an op which has a child that believes it has a sibling. The relevant op is created at: #0 Perl_newUNOP (type=26, flags=0, first=0x600077ab8) at op.c:4783 #1 0x0000000100463834 in S_scan_inputsymbol (start=0x6000742c5 "<>\n") at toke.c:9603 #2 0x000000010044f84f in Perl_yylex () at toke.c:5926 #3 0x00000001004697d2 in Perl_yyparse (gramtype=258) at perly.c:322 #4 0x0000000100404538 in S_parse_body (env=0x0, xsinit=0x10042f9e9 <xs_init>) at perl.c:2296 #5 0x00000001004036d5 in perl_parse (my_perl=0x60003ab40, xsinit=0x10042f9e9 <xs_init>, argc=2, argv=0x22aac0, env=0x0) at perl.c:1626 #6 0x000000010042f93b in main (argc=2, argv=0x22aac0, env=0x6000281a0) at miniperlmain.c:120 At the time of the crash, the following is true: (gdb) p ((UNOP*)0x600077a78)->op_first $32 = (OP *) 0x600077ab8 (gdb) p ((OP*)0x600077ab8)->op_sibling $33 = (OP *) 0x300000000 The child's op_sibling becomes non-NULL at the following line: 1347 SvFLAGS(sv) |= new_type; (gdb) p ((OP*)0x600077ab8)->op_sibling $52 = (OP *) 0x0 (gdb) s 1352 switch (new_type) { (gdb) p ((OP*)0x600077ab8)->op_sibling $53 = (OP *) 0x300000000 (gdb) bt #0 Perl_sv_upgrade (sv=0x600077ab8, new_type=SVt_PV) at sv.c:1352 #1 0x00000001004eb26d in Perl_sv_2pv_flags (sv=0x600077ab8, lp=0x22a168, flags=34) at sv.c:3223 #2 0x000000010041f426 in Perl_newATTRSUB_x (floor=39, o=0x6000777c8, proto=0x600077a78, attrs=0x0, block=0x0, o_is_gv=false) at op.c:8459 #3 0x000000010046a20f in Perl_yyparse (gramtype=258) at perly.y:294 #4 0x0000000100404538 in S_parse_body (env=0x0, xsinit=0x10042f9e9 <xs_init>) at perl.c:2296 #5 0x00000001004036d5 in perl_parse (my_perl=0x60003ab40, xsinit=0x10042f9e9 <xs_init>, argc=2, argv=0x22aac0, env=0x0) at perl.c:1626 #6 0x000000010042f93b in main (argc=2, argv=0x22aac0, env=0x6000281a0) at miniperlmain.c:120 This memory appears to be being used as both an OP and an SV. This appears to be problematic. See for example: (gdb) p sv $66 = (SV * const) 0x600077ab8 (gdb) p ((UNOP*)0x600077a78)->op_first # Some time in the future, this address will be passed to Perl_op_free $67 = (OP *) 0x600077ab8 (gdb) p *sv $68 = {sv_any = 0x600077ab8, sv_refcnt = 0, sv_flags = 3, sv_u = { svu_pv = 0x1004d8257 <Perl_pp_gv> "UH\211\345H\203\354\060H\213\005\212%\022", svu_iv = 4300046935, svu_uv = 4300046935, svu_nv = 2.1245054660884477e-314, svu_rv = 0x1004d8257 <Perl_pp_gv>, svu_rx = 0x1004d8257 <Perl_pp_gv>, svu_array = 0x1004d8257 <Perl_pp_gv>, svu_hash = 0x1004d8257 <Perl_pp_gv>, svu_gp = 0x1004d8257 <Perl_pp_gv>, svu_fp = 0x1004d8257 <Perl_pp_gv>}} (gdb) p *(OP*)0x600077ab8 $69 = {op_next = 0x600077ab8, op_sibling = 0x300000000, op_ppaddr = 0x1004d8257 <Perl_pp_gv>, op_targ = 0, op_type = 7, op_opt = 0, op_slabbed = 1, op_savefree = 0, op_static = 0, op_folded = 0, op_moresib = 0, op_spare = 0, op_flags = 2 '\002', op_private = 0 '\000'} I'm not sure if this memory was freed somewhere and reused, and we have failed to null out ((UNOP*)0x600077a78)->op_first before using the memory it points to to store an SV, or if some other witchcraft has allowed this to occur, so I'll hand it off to you. $ perl -V Summary of my perl5 (revision 5 version 14 subversion 4) configuration: Platform: osname=cygwin, osvers=1.7.18(0.26353), archname=cygwin-thread-multi uname='cygwin_nt-6.1 yaakov04 1.7.18(0.26353) 2013-03-07 19:25 x86_64 cygwin ' config_args='-d -e -Dprefix=/usr -Dmksymlinks -Dusethreads -Darchname=x86_64-cygwin-threads -Dlibperl=cygperl5_14.dll -Dcc=gcc -Dld=g++' hint=recommended, useposix=true, d_sigaction=define useithreads=define, usemultiplicity=define useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='gcc', ccflags ='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fno-strict-aliasing -pipe -fstack-protector', optimize='-O3', cppflags='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fno-strict-aliasing -pipe -fstack-protector' ccversion='', gccversion='4.8.0 20130307 (experimental)', 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='g++', ldflags =' -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -fstack-protector' libpth=/usr/lib /lib libs=-lgdbm -ldb -ldl -lcrypt -lgdbm_compat perllibs=-ldl -lcrypt libc=/usr/lib/libc.a, so=dll, useshrplib=true, libperl=cygperl5_14.dll gnulibc_version='' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags=' --shared -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -fstack-protector' Characteristics of this binary (from libperl): Compile-time options: MULTIPLICITY PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT PERL_PRESERVE_IVUV PERL_USE_SAFE_PUTENV USE_64_BIT_ALL USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES USE_PERLIO USE_PERL_ATOF USE_REENTRANT_API Locally applied patches: Bug#55162 File::Spec::case_tolerant performance CYG07 $vendorarch/auto/.rebase CYG15 static Win32CORE CYG17 cyg-1.7 paths-utf8 0c612ce82 Fix building static extensions on cygwin, -UUSEIMPORTLIB 1bac5ecc1 Fix 64-bit threading sv.c: S_anonymise_cv_maybe Cygwin::sync_winenv added Built under cygwin Compiled at Mar 11 2013 18:25:23 @INC: /usr/lib/perl5/site_perl/5.14/x86_64-cygwin-threads /usr/lib/perl5/site_perl/5.14 /usr/lib/perl5/vendor_perl/5.14/x86_64-cygwin-threads /usr/lib/perl5/vendor_perl/5.14 /usr/lib/perl5/5.14/x86_64-cygwin-threads /usr/lib/perl5/5.14 . $ ./miniperl -Ilib -V Summary of my perl5 (revision 5 version 22 subversion 0) configuration: Platform: osname=cygwin, osvers=1.7.28(0.27153), archname=cygwin uname='cygwin_nt-6.1 wdlkhr204823 1.7.28(0.27153) 2014-02-09 21:06 x86_64 cygwin ' config_args='' hint=recommended, useposix=true, d_sigaction=define useithreads=undef, usemultiplicity=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='gcc', ccflags ='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include', optimize='-g', cppflags='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__ -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.8.2', gccosandvers='' intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678, doublekind=3 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16, longdblkind=3 ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='g++', ldflags =' -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /usr/lib/gcc/x86_64-pc-cygwin/4.8.2/include-fixed /usr/lib /usr/lib/gcc/x86_64-pc-cygwin/4.8.2/../../../../lib/../include/w32api /lib libs=-lpthread -ldb -ldl -lcrypt perllibs=-lpthread -ldl -lcrypt libc=/usr/lib/libc.a, so=dll, useshrplib=true, libperl=cygperl5_22_0.dll gnulibc_version='' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags=' --shared -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base -L/usr/local/lib -fstack-protector' Characteristics of this binary (from libperl): Compile-time options: HAS_TIMES PERLIO_LAYERS PERL_DONT_CREATE_GVSV PERL_EXTERNAL_GLOB PERL_HASH_FUNC_ONE_AT_A_TIME_HARD PERL_IS_MINIPERL PERL_NEW_COPY_ON_WRITE PERL_PRESERVE_IVUV PERL_USE_SAFE_PUTENV USE_64_BIT_ALL USE_64_BIT_INT USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LOCALE_TIME USE_PERLIO USE_PERL_ATOF USE_SITECUSTOMIZE Built under cygwin Compiled at Aug 11 2015 10:01:48 @INC: /home/daniel.r.collins1/perl-5.22.0/cpan/AutoLoader/lib /home/daniel.r.collins1/perl-5.22.0/dist/Carp/lib /home/daniel.r.collins1/perl-5.22.0/dist/PathTools /home/daniel.r.collins1/perl-5.22.0/dist/PathTools/lib /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-Command/lib /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-Install/lib /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-MakeMaker/lib /home/daniel.r.collins1/perl-5.22.0/cpan/ExtUtils-Manifest/lib /home/daniel.r.collins1/perl-5.22.0/cpan/File-Path/lib /home/daniel.r.collins1/perl-5.22.0/ext/re /home/daniel.r.collins1/perl-5.22.0/dist/Term-ReadLine/lib /home/daniel.r.collins1/perl-5.22.0/dist/Exporter/lib /home/daniel.r.collins1/perl-5.22.0/ext/File-Find/lib /home/daniel.r.collins1/perl-5.22.0/cpan/Text-Tabs/lib /home/daniel.r.collins1/perl-5.22.0/dist/constant/lib /home/daniel.r.collins1/perl-5.22.0/lib .
From: Zefram <zefram [...] fysh.org>
To: perl5-porters [...] perl.org
Subject: Re: [perl #125789] Perl segfaults while handling a syntax error, appears to be reusing an OP as an SV
Date: Tue, 11 Aug 2015 23:34:11 +0100
Download (untitled) / with headers
text/plain 195b
Dan Collins wrote: Show quoted text
>$ od -c ../test1.pl >0000000 B E G I N < > \n
This is a duplicate of [perl #121048]. (Except that the test code in that ticket has braces as well.) -zefram
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 164b
On Sat Jun 06 09:02:11 2015, brian.carpenter@gmail.com wrote: Show quoted text
> perl -e 'BEGIN<>'
Fixed with the attached patch failing with a proper error message -- Reini Urban
Subject: 0001-add-panic-wrong-function-prototype-for-funcname.patch
From c1aaf18b8a9c21d60b022e33efd9c3c354eb6dd4 Mon Sep 17 00:00:00 2001 From: Reini Urban <rurban@cpanel.net> Date: Wed, 12 Aug 2015 10:51:15 +0200 Subject: [PATCH] add panic: wrong function prototype for funcname Fixes RT #125341, -e'BEGIN<>' where the readline term was used as proto for a function. All THINGS (literals) are allowed, but only CONST is accepted. Rather panic with a proper message than just assert. --- op.c | 4 +++- pod/perldiag.pod | 5 +++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git op.c op.c index e652ed2..ffc625d 100644 --- op.c +++ op.c @@ -8451,7 +8451,9 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, isGV(gv) ? gv : (GV *)cSVOPo->op_sv); if (proto) { - assert(proto->op_type == OP_CONST); + if (OP_TYPE_ISNT(proto, OP_CONST)) + Perl_croak(aTHX_ "panic: wrong function prototype %s for %s", + OP_NAME(proto), name); ps = SvPV_const(((SVOP*)proto)->op_sv, ps_len); ps_utf8 = SvUTF8(((SVOP*)proto)->op_sv); } diff --git pod/perldiag.pod pod/perldiag.pod index 7004aeb..32ea7f0 100644 --- pod/perldiag.pod +++ pod/perldiag.pod @@ -4440,6 +4440,11 @@ to even) byte length. (P) Something tried to call utf16_to_utf8_reversed with an odd (as opposed to even) byte length. +=item panic: wrong function prototype %s for %s + +(P) A function declaration expects a CONST prototype, but a wrong prototype +was declared. + =item panic: yylex, %s (P) The lexer got into a bad state while processing a case modifier. -- 2.4.5
RT-Send-CC: perl5-porters [...] perl.org
Please see my patch at RT #125341 -- Reini Urban
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 531b
On Sat Jun 06 09:02:11 2015, brian.carpenter@gmail.com wrote: Show quoted text
> The following "script" causes two behaviors to manifest in two > different versions of Perl. > > perl -e 'BEGIN<>'
The attached seems to fix it. I have an alternate change that turns the prototype into a new token type (rather than THING) and that worked, but then I noticed this block and making the fix there allows BEGIN <> to behave more closely to sub foo <>. Reini's patch turns the assert() (or crash) into a panic, which isn't really an improvement. Tony
Subject: 0001-perl-125341-check-for-unexpected-trash-after-any-sub.patch
From dce3a02fc588b60ec375dda1004e15975b7f1e5f Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 24 Aug 2015 11:46:35 +1000 Subject: [perl #125341] check for unexpected trash after any sub start --- t/lib/croak/toke | 5 +++++ toke.c | 8 +++++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/t/lib/croak/toke b/t/lib/croak/toke index 78ff6cd..64012fb 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -279,3 +279,8 @@ state ($x, $y, state $z); EXPECT Can't redeclare "state" in "state" at - line 2, near ", " Execution of - aborted due to compilation errors. +######## +# NAME BEGIN <> [perl #125341] +BEGIN <> +EXPECT +Illegal declaration of subroutine BEGIN at - line 1. diff --git a/toke.c b/toke.c index 7a0f1b6..4814352 100644 --- a/toke.c +++ b/toke.c @@ -8100,7 +8100,13 @@ Perl_yylex(pTHX) if (*s == ':' && s[1] != ':') PL_expect = attrful; - else if ((*s != '{' && *s != '(') && key == KEY_sub) { + else if ((*s != '{' && *s != '(') && key != KEY_format) { + assert(key == KEY_sub || key == KEY_AUTOLOAD || + key == KEY_DESTROY || key == KEY_BEGIN || + key == KEY_UNITCHECK || key == KEY_CHECK || + key == KEY_INIT || key == KEY_END || + key == KEY_my || key == KEY_state || + key == KEY_our); if (!have_name) Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine"); else if (*s != ';' && *s != '}') -- 2.1.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 333b
On Sun Aug 23 18:50:10 2015, tonyc wrote: Show quoted text
> On Sat Jun 06 09:02:11 2015, brian.carpenter@gmail.com wrote:
> > The following "script" causes two behaviors to manifest in two > > different versions of Perl. > > > > perl -e 'BEGIN<>'
> > The attached seems to fix it.
Pushed to blead as e6b2cf838e87ec34b3a2043c947b4f723d6efcca. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 491b
On Wed Aug 26 21:08:46 2015, tonyc wrote: Show quoted text
> On Sun Aug 23 18:50:10 2015, tonyc wrote:
> > On Sat Jun 06 09:02:11 2015, brian.carpenter@gmail.com wrote:
> > > The following "script" causes two behaviors to manifest in two > > > different versions of Perl. > > > > > > perl -e 'BEGIN<>'
> > > > The attached seems to fix it.
> > Pushed to blead as e6b2cf838e87ec34b3a2043c947b4f723d6efcca.
Tickets 121048, 125341 and 125789 are all the same issue, which was fixed by the commit above. 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