-
Notifications
You must be signed in to change notification settings - Fork 560
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Argument croak_on_error for eval_pv() is broken #17036
Comments
From @paliHere is test example which proves that when croak_on_error is set to 1 Just compile it, run and see that die from eval_pv with croak_on_error=1 $ xsubpp -prototypes -output test.c test.xs Source test code is below: $ cat test.pm use XSLoader; use strict; eval { eval_pv 'die bool_obj->new(0)'; 1 } and do { print "ERROR: eval_pv not died\n"; 1; } or do { print "OK: eval_pv died with \$@=$@" }; package bool_obj; 1; $ cat test.xs MODULE = test PACKAGE = test void |
From @paliWhat about checking for SvROK? Or installing __DIE__ handler and |
From @tonycozOn Fri, 14 Jun 2019 00:44:07 -0700, pali@cpan.org wrote:
When I suggested using ROK in #p5p you brought up clobbering Using a __DIE__ handler would be unnecessarily complex - you'd be better off modifying eval_sv()[1] to accept a G_RETHROW flag, which wouldn't be too hard. Is there some way changing: if(SvTRUE_NN(errsv)) to if(SvTRUE_NN(errsv) || SvROK(errsv)) doesn't solve this? Tony [1] G_EVALBYTE and G_EVALUNICODE to match OPpEVAL_BYTES and OPpEVAL_UNICODE might also be useful. |
The RT System itself - Status changed from 'new' to 'open' |
From @paliOn Sunday 16 June 2019 21:40:43 Tony Cook via RT wrote:
Seems like introduction of G_RETHROW in eval_sv() is the best way.
Rather check SvROK before SvTRUE if(SvROK(errsv) || SvTRUE_NN(errsv)) as SvTRUE would call object overloaded method. And it is useless.
So is clobbering of $@ in eval_sv() possible or not?
|
From @tonycozOn Mon, 17 Jun 2019 01:06:58 -0700, pali@cpan.org wrote:
See the attached.
Not that it matters if the attached is applied, but the checks SvTRUE() does seem more likely to matter than the SvROK() check in most common cases.
Evals called within whatever code eval_sv() calls can still clobber $@. Tony |
From @tonycoz0001-perl-134177-add-G_RETHROW-flag-to-eval_sv.patchFrom f79274795bd1fbd4808a731648ea158a964a14de Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 20 Jun 2019 15:26:22 +1000
Subject: (perl #134177) add G_RETHROW flag to eval_sv()
and update eval_pv() to use it.
---
cop.h | 1 +
ext/XS-APItest/Makefile.PL | 2 +-
ext/XS-APItest/t/call.t | 26 +++++++++++++++++++++++++-
perl.c | 25 ++++++++++++++++---------
4 files changed, 43 insertions(+), 11 deletions(-)
diff --git a/cop.h b/cop.h
index fca2aa755c..9cf85ef883 100644
--- a/cop.h
+++ b/cop.h
@@ -973,6 +973,7 @@ L<perlcall>.
Perl_magic_methcall(). */
#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */
#define G_METHOD_NAMED 4096 /* calling named method, eg without :: or ' */
+#define G_RETHROW 8192 /* eval_sv(): re-throw any error */
/* flag bits for PL_in_eval */
#define EVAL_NULL 0 /* not in an eval */
diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL
index d79ba1150e..3fe5e397a8 100644
--- a/ext/XS-APItest/Makefile.PL
+++ b/ext/XS-APItest/Makefile.PL
@@ -23,7 +23,7 @@ WriteMakefile(
my @names = (qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
HV_FETCH_ISEXISTS HV_FETCH_LVALUE HV_FETCH_JUST_SV
G_SCALAR G_ARRAY G_VOID G_DISCARD G_EVAL G_NOARGS
- G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL
+ G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL G_RETHROW
GV_NOADD_NOINIT
IS_NUMBER_IN_UV IS_NUMBER_GREATER_THAN_UV_MAX
IS_NUMBER_NOT_INT IS_NUMBER_NEG IS_NUMBER_INFINITY
diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t
index 632a421d4f..e4228077cb 100644
--- a/ext/XS-APItest/t/call.t
+++ b/ext/XS-APItest/t/call.t
@@ -11,7 +11,7 @@ use strict;
BEGIN {
require '../../t/test.pl';
- plan(530);
+ plan(538);
use_ok('XS::APItest')
};
@@ -228,6 +228,30 @@ is(eval { eval_pv(q/die $obj/, 1) }, undef,
ok(ref $@, "object thrown");
is($@, $obj, "check object rethrown");
+package False {
+ use overload
+ bool => sub { 0 },
+ '""' => sub { "Foo" };
+ sub new { bless {}, shift }
+};
+my $false = False->new;
+ok(!$false, "our false object is actually false");
+is(eval { eval_pv(q/die $false;/, 1); 1 }, undef,
+ "check false objects are rethrown");
+is(overload::StrVal($@), overload::StrVal($false),
+ "check we got the expected object");
+
+is(eval { eval_sv(q/die $false/, G_RETHROW); 1 }, undef,
+ "check G_RETHROW for thrown object");
+is(overload::StrVal($@), overload::StrVal($false),
+ "check we got the expected object");
+is(eval { eval_sv(q/"unterminated/, G_RETHROW); 1 }, undef,
+ "check G_RETHROW for syntax error");
+like($@, qr/Can't find string terminator/,
+ "check error rethrown");
+ok(eq_array([ eval { eval_sv(q/"working code"/, G_RETHROW) } ], [ "working code", 1 ]),
+ "check for spurious rethrow");
+
# #3719 - check that the eval call variants handle exceptions correctly,
# and do the right thing with $@, both with and without G_KEEPERR set.
diff --git a/perl.c b/perl.c
index e71ecaf8fc..d851099a1d 100644
--- a/perl.c
+++ b/perl.c
@@ -3101,6 +3101,9 @@ Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
Tells Perl to C<eval> the string in the SV. It supports the same flags
as C<call_sv>, with the obvious exception of C<G_EVAL>. See L<perlcall>.
+The C<G_RETHROW> flag can be used if you only need eval_sv() to
+execute code specified by a string, but not catch any errors.
+
=cut
*/
@@ -3182,6 +3185,11 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
goto redo_body;
}
fail:
+ if (flags & G_RETHROW) {
+ JMPENV_POP;
+ croak_sv(ERRSV);
+ }
+
PL_stack_sp = PL_stack_base + oldmark;
if ((flags & G_WANT) == G_ARRAY)
retval = 0;
@@ -3218,8 +3226,14 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
PERL_ARGS_ASSERT_EVAL_PV;
- eval_sv(sv, G_SCALAR);
- SvREFCNT_dec(sv);
+ if (croak_on_error) {
+ sv_2mortal(sv);
+ eval_sv(sv, G_SCALAR | G_RETHROW);
+ }
+ else {
+ eval_sv(sv, G_SCALAR);
+ SvREFCNT_dec(sv);
+ }
{
dSP;
@@ -3227,13 +3241,6 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
PUTBACK;
}
- /* just check empty string or undef? */
- if (croak_on_error) {
- SV * const errsv = ERRSV;
- if(SvTRUE_NN(errsv))
- croak_sv(errsv);
- }
-
return sv;
}
--
2.11.0
|
From @paliOn Wednesday 19 June 2019 22:31:43 Tony Cook via RT wrote:
Looks good, thanks!
Yes, it does not matter for patch which is attached, but SvROK() just
I tried to play with it, but I was not able to write any code which |
From @tonycozOn Thu, Jun 20, 2019 at 10:18:40AM +0200, pali@cpan.org wrote:
It has no effect on that, I meant that: ./perl -Ilib -MXS::APItest -le '$@ = "foo"; eval_sv("eval q/1/", G_KEEPERR); print $@' $@ isn't preserved. Tony |
From @paliOn Thursday 20 June 2019 02:49:00 Tony Cook via RT wrote:
I mean $@ clobbering in eval_pv(). E.g. when eval_pv() is called with |
From @tonycozOn Thu, 20 Jun 2019 02:51:32 -0700, pali@cpan.org wrote:
eval_pv() never uses (and never will for compatibility) the G_KEEPERR flag when calling eval_sv(), so it will always clobber $@. Tony |
From @paliOn Sunday 23 June 2019 18:42:34 Tony Cook via RT wrote:
I tried to create any other examples where eval_pv() with All following examples works correctly, no error/fail. eval { eval_pv '$@ = "croak"'; 1 } and do { print "OK: eval_pv not died, \$@=$@\n"; 1 } or do { print "ERROR: eval_pv died with \$@=$@" }; So how can *unpatched* eval_pv() clobbers $@ and make croak_on_error=1 |
From @paliOn Wednesday 19 June 2019 22:31:43 Tony Cook via RT wrote:
Hi! Have you applied this G_RETHROW patch? |
From @tonycozOn Thu, 04 Jul 2019 03:11:45 -0700, pali@cpan.org wrote:
Thanks for your feedback. Tony |
@tonycoz - Status changed from 'open' to 'pending release' |
From @paliOn Sunday 07 July 2019 18:57:12 Tony Cook via RT wrote:
Thanks! Now reminds only my question about clobbering: |
Migrated from rt.perl.org#134177 (status was 'pending release')
Searchable as RT134177$
The text was updated successfully, but these errors were encountered: