This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
eval $overloaded can crash
authorDavid Mitchell <davem@iabyn.com>
Tue, 22 Jun 2010 23:23:24 +0000 (00:23 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sat, 3 Jul 2010 15:25:58 +0000 (16:25 +0100)
Perl_lex_start() assumes that the SV passed to it is a well-behaved
string that it can do PVX() stuff to. If it's actually a ref to an
overloaded object, it can crash and burn. Fixed by creating a stringified
copy of the SV if necessary.

t/op/eval.t
toke.c

index ff5004e..0a5fadc 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-print "1..106\n";
+print "1..107\n";
 
 eval 'print "ok 1\n";';
 
@@ -604,3 +604,10 @@ eval q{ eval { + } };
 print "ok\n";
 EOP
 
+fresh_perl_is(<<'EOP', "ok\n", undef, 'assert fail on non-string in Perl_lex_start');
+use overload '""'  => sub { '1;' };
+my $ov = bless [];
+eval $ov;
+print "ok\n";
+EOP
+
diff --git a/toke.c b/toke.c
index ac00450..5e2dc75 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -714,8 +714,9 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
 
     if (!len) {
        parser->linestr = newSVpvs("\n;");
-    } else if (SvREADONLY(line) || s[len-1] != ';') {
-       parser->linestr = newSVsv(line);
+    } else if (SvREADONLY(line) || s[len-1] != ';' || !SvPOK(line)) {
+       parser->linestr = newSV_type(SVt_PV);
+       sv_copypv(parser->linestr, line); /* avoid tie/overload weirdness */
        if (s[len-1] != ';')
            sv_catpvs(parser->linestr, "\n;");
     } else {