Skip Menu |
 

This queue is for tickets about the Future-AsyncAwait CPAN distribution.

Report information
The Basics
Id: 129987
Status: new
Priority: 0/
Queue: Future-AsyncAwait

People
Owner: Nobody in particular
Requestors: leonerd-cpan [...] leonerd.org.uk
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: 0.30
Fixed in: (no value)



Subject: Segmentation Fault on runaway braces
Download (untitled) / with headers
text/plain 264b
$ perl -MFuture::AsyncAwait -ce 'async sub foo {' Segmentation fault vs. $ perl -MFuture::AsyncAwait -ce 'sub foo {' Missing right curly or square bracket at -e line 1, at end of line syntax error at -e line 1, at EOF -e had compilation errors. -- Paul Evans
Download (untitled) / with headers
text/plain 1013b
Another test case; note the mismatched paren on `my $nested = ...`: #!/usr/bin/env perl use Syntax::Keyword::Try; use Future::AsyncAwait; my $pending = Future->new; my $pending2 = Future->new; my $final = (async sub { my ($f) = @_; try { await $f; my $nested = async sub { await shift; })->($pending2); return await $nested; } catch { } })->($pending); segfaults, but a smaller test case of #!/usr/bin/env perl use Syntax::Keyword::Try; use Future::AsyncAwait; my $pending = Future->new; my $pending2 = Future->new; my $sub = async sub { my ($f) = @_; try { await $f; my $nested = async sub { await shift; })->($pending2); return await $nested; } catch { } }; Still mismatched but now correctly reported as syntax error at rt.pl line 14, near "})" Execution of rt.pl aborted due to compilation errors. -- Paul Evans
Download (untitled) / with headers
text/plain 128b
And another: $ perl -MFuture::AsyncAwait -ce '(async sub { my $x = async sub { await 1; })' Segmentation fault -- Paul Evans
Some of these test cases fixed by this patch. But the second one still fails. -- Paul Evans
Subject: rt129987-1.patch
Download rt129987-1.patch
text/x-diff 1.6k
=== modified file 'lib/Future/AsyncAwait.xs' --- lib/Future/AsyncAwait.xs 2019-09-08 04:08:35 +0000 +++ lib/Future/AsyncAwait.xs 2019-09-11 15:55:49 +0000 @@ -2214,15 +2214,20 @@ I32 save_ix = block_start(TRUE); OP *body = parse_block(0); - - COP *last_cop = PL_curcop; - check_optree(aTHX_ body, NO_FORBID, &last_cop); - - SvREFCNT_inc(PL_compcv); - body = block_end(save_ix, body); + /* body might be NULL if an error happened; we check that below so for now + * just be defensive + */ + if(body) { + COP *last_cop = PL_curcop; + check_optree(aTHX_ body, NO_FORBID, &last_cop); + + SvREFCNT_inc(PL_compcv); + body = block_end(save_ix, body); + } if(PL_parser->error_count) { - /* parse_block() still returns a valid body even if a parse error happens. + /* parse_block() still sometimes returns a valid body even if a parse + * error happens. * We need to destroy this partial body before returning a valid(ish) * state to the keyword hook mechanism, so it will find the error count * correctly === added file 't/90rt129987.t' --- t/90rt129987.t 1970-01-01 00:00:00 +0000 +++ t/90rt129987.t 2019-09-11 15:55:49 +0000 @@ -0,0 +1,23 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use Future::AsyncAwait; + +# All of these should fail to compile but not SEGV. If we get to the end of +# the script without segfaulting, we've passed. + +ok( !defined eval q' + async sub foo { + ', + 'Test case 1 does not segfault' ); + +ok( !defined eval q' + (async sub { my $x = async sub { await 1; }) + ', + 'Test case 3 does not segfault' ); + +done_testing;


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

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.