p5pRT
commented
22 years ago From john@pc.xs4all.nl
Created by john@pc.xs4all.nl
This is a bug report for perl from john@pc.xs4all.nl\, generated with the help of perlbug 1.33 running under perl v5.7.2.
---------------------------------------------------------------- In some circumstances\, perl dumps core after executing code embedded in a regular expression\, with (?{ code... }). The following program is an example of this.
The crash happens with perl 5.6.1\, perl 5.7.2\, and the latest bleadperl. The code doesn't compile with perl 5.005_03\, the (?{ code }) construct wasn't mature enough back then\, apparently.
I haven't really tried to minimize this. If this is a known issue\, I'd rather not waste too much time on it. However if someone is interested in fixing this\, I can try to reduce the example to a bare minimum.
The workaround is to move code out of the regex itself\, and only do a minimum amount of work inside the re. So I did manage to match the $sillytimestamp\, using a slightly modified version.
Here is the program:
----8\<-BEGIN-PROGRAM------- #!/usr/bin/perl
use Time::Local; use strict;
use re 'debug';
sub match { my $str = shift; $str =~ m{ ^ (\d|[1-5]\d) # seconds (\d|[1-5]\d) # minutes (\d|1\d|2[0-3]) # hours ([1-9]|[12]\d|3[01]) # mday (\d|1[01]) # mon ([2-9]|[1-9]\d|1[0-2]\d|13[0-7]) # year ([0-6]) # wday (\d|[1-9]\d|[12]\d\d|3[0-5]\d|36[0-5]) # yday ([01]) # isdst $ (?{ print "Possible match: $1-$2-$3-$4-$5-$6-$7-$8-$9\n"; my $t = timelocal($1\, $2\, $3\, $4\, $5\, 1900 + $6); print "Possible date: $t\n"; my @lt = localtime($t); print "Localtime is @lt\n"; if ( $lt[6] == $7 && $lt[7] == $8 && $lt[8] == $9 ) { print "MATCH! "\, scalar localtime $t\, "\n"; } }) }x; }
my $sillytimestamp = "251013211010133240"; match($sillytimestamp); ----END-PROGRAM->8--------
This is (a portion of) the output\, when run under yesterday's bleadperl compiled with -DDEBUGGING.
----8\<-BEGIN-OUTPUT------- pc:\~/perl/bleadperl $ ./perl -Ilib -w ../localtime_play/recrash Compiling REx ` ^ (\d|[1-5]\d) # seconds (\d|[1-5]\d) # minutes (\d|1\d|2[0-3]) # hours ([1-9]|[12]\d|3[01]) # mday (\d|1[01]) # mon ([2-9]|[1-9]\d|1[0-2]\d|13[0-7]) # year ([0-6]) # wday (\d|[1-9]\d|[12]\d\d|3[0-5]\d|36[0-5]) # yday ([01]) # isdst $ (?{ print "Possible match: $1-$2-$3-$4-$5-$6-$7-$8-$9\n"; my $t = timelocal($1\, $2\, $3\, $4\, $5\, 1900 + $6); print "Possible date: $t\n"; my @lt = localtime($t); print "Localtime is @lt\n"; if ( $lt[6] == $7 && $lt[7] == $8 && $lt[8] == $9 ) { print "MATCH! "\, scalar localtime $t\, "\n"; } }) ' size 280 Got 2244 bytes for offset annotations. first at 2 rarest char at 0 1: BOL(2) [...] EXECUTING... [...] 17 \<21101013324> \<0> |264: ANYOF[01] 18 \<211010133240> \<> |275: CLOSE9 18 \<211010133240> \<> |277: EOL 18 \<211010133240> \<> |278: EVAL re_eval 0x81a6040 Possible match: 25-10-13-21-10-101-3-324-0 Possible date: 1006344625 Localtime is 25 10 13 21 10 101 3 324 0 MATCH! Wed Nov 21 13:10:25 2001 18 \<211010133240> \<> |280: END Match successful! Segmentation fault (core dumped) ----END-OUTPUT->8--------
And here is what gdb says about the generated core file:
pc:\~/perl/bleadperl $ gdb perl core GNU gdb 19991004 Copyright 1998 Free Software Foundation\, Inc. GDB is free software\, covered by the GNU General Public License\, and you are welcome to change it and/or distribute copies of it under certain conditions. Type "show copying" to see the conditions. There is absolutely no warranty for GDB. Type "show warranty" for details. This GDB was configured as "i386-redhat-linux"... Core was generated by `./perl -Ilib -w ../localtime_play/recrash'. Program terminated with signal 11\, Segmentation fault. Reading symbols from /lib/libnsl.so.1...done. Reading symbols from /lib/libdl.so.2...done. Reading symbols from /lib/libm.so.6...done. Reading symbols from /lib/libc.so.6...done. Reading symbols from /lib/libcrypt.so.1...done. Reading symbols from /lib/libutil.so.1...done. Reading symbols from /lib/ld-linux.so.2...done. Reading symbols from /usr/home/john/perl/bleadperl/lib/auto/re/re.so...done. #0 0x80f3b9c in Perl_leave_scope (base=13) at scope.c:825 825 if (SvREFCNT(sv) \<= 1 && !SvOBJECT(sv)) { (gdb) bt #0 0x80f3b9c in Perl_leave_scope (base=13) at scope.c:825 #1 0x80c5eb7 in Perl_pp_match () at pp_hot.c:1375 #2 0x80ac7f4 in Perl_runops_debug () at dump.c:1388 #3 0x805ff89 in S_run_body (oldscope=1) at perl.c:1595 #4 0x805fb6b in perl_run (my_perl=0x816ae68) at perl.c:1516 #5 0x805c912 in main (argc=4\, argv=0xbffff804\, env=0xbffff818) at perlmain.c:76 (gdb) x sv 0x2: Cannot access memory at address 0x2
Migrated from rt.perl.org#8027 (status was 'resolved')
Searchable as RT8027$