diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2014-12-20 06:50:12 -0800 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2014-12-21 07:06:13 -0800 |
| commit | 2e4af4cf6b38b2c5a571e1232ee507b8a01cda8a (patch) | |
| tree | f835bc29cc655e453334b417704045c27a1874ed /ext | |
| parent | cee11a521f0966a42b8be1949f915e0c926c9f20 (diff) | |
| download | perl-2e4af4cf6b38b2c5a571e1232ee507b8a01cda8a.tar.gz | |
Propagate context properly in Safe->reval
(or, rather, in Opcode.xs).
It was providing scalar context when invoked in void context. Test-
ing Safe->reval itself is complicated, because Opcode.xs, which is an
essential part of the fix, is not dual-life.
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/Opcode/Opcode.xs | 3 | ||||
| -rw-r--r-- | ext/Opcode/t/Opcode.t | 17 |
2 files changed, 19 insertions, 1 deletions
diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 594f5b2723..9d657f884c 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -315,7 +315,8 @@ PPCODE: hv_clear(PL_stashcache); PUSHMARK(SP); - perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ + /* use caller’s context */ + perl_call_sv(codesv, GIMME_V|G_EVAL|G_KEEPERR); sv_free( (SV *) dummy_hv); /* get rid of what save_hash gave us*/ SPAGAIN; /* for the PUTBACK added by xsubpp */ LEAVE; diff --git a/ext/Opcode/t/Opcode.t b/ext/Opcode/t/Opcode.t index 1c0b427f9d..82028cc5b2 100644 --- a/ext/Opcode/t/Opcode.t +++ b/ext/Opcode/t/Opcode.t @@ -113,6 +113,23 @@ is(($s2 ^ $s3), opset('padsv','padhv')); my @o2 = opset_to_ops(invert_opset $s3); is_deeply(\@o1, \@o2); +# --- test context of undocumented _safe_call_sv (used by Safe.pm) + +my %inc = %INC; +my $expect; +sub f { + %INC = %inc; + no warnings 'uninitialized'; + is wantarray, $expect, + sprintf "_safe_call_sv gives %s context", + qw[void scalar list][$expect + defined $expect] +}; +Opcode::_safe_call_sv("main", empty_opset, \&f); +$expect = !1; +$_ = Opcode::_safe_call_sv("main", empty_opset, \&f); +$expect = !0; +() = Opcode::_safe_call_sv("main", empty_opset, \&f); + # --- finally, check some opname assertions foreach my $opname (@full_l1) { |