eval_pv eval_sv call_sv call_pv call_argv call_method

/* Replace: 1 */ __UNDEFINED__ call_sv perl_call_sv __UNDEFINED__ call_pv perl_call_pv __UNDEFINED__ call_argv perl_call_argv __UNDEFINED__ call_method perl_call_method

__UNDEFINED__ eval_sv perl_eval_sv /* Replace: 0 */

/* Replace perl_eval_pv with eval_pv */ /* eval_pv depends on eval_sv */

#ifndef eval_pv #if { NEED eval_pv }

SV* eval_pv(char *p, I32 croak_on_error) { dSP; SV* sv = newSVpv(p, 0);

    PUSHMARK(sp);
    eval_sv(sv, G_SCALAR);
    SvREFCNT_dec(sv);

    SPAGAIN;
    sv = POPs;
    PUTBACK;

    if (croak_on_error && SvTRUE(GvSV(errgv)))
	croak(SvPVx(GvSV(errgv), na));

    return sv;
}

#endif #endif

#define NEED_eval_pv

I32 G_SCALAR() CODE: RETVAL = G_SCALAR; OUTPUT: RETVAL

I32 G_ARRAY() CODE: RETVAL = G_ARRAY; OUTPUT: RETVAL

I32 G_DISCARD() CODE: RETVAL = G_DISCARD; OUTPUT: RETVAL

void eval_sv(sv, flags) SV* sv I32 flags PREINIT: I32 i; PPCODE: PUTBACK; i = eval_sv(sv, flags); SPAGAIN; EXTEND(SP, 1); PUSHs(sv_2mortal(newSViv(i)));

void eval_pv(p, croak_on_error) char* p I32 croak_on_error PPCODE: PUTBACK; EXTEND(SP, 1); PUSHs(eval_pv(p, croak_on_error));

void call_sv(sv, flags, ...) SV* sv I32 flags PREINIT: I32 i; PPCODE: for (i=0; i<items-2; i++) ST(i) = ST(i+2); /* pop first two args */ PUSHMARK(SP); SP += items - 2; PUTBACK; i = call_sv(sv, flags); SPAGAIN; EXTEND(SP, 1); PUSHs(sv_2mortal(newSViv(i)));

void call_pv(subname, flags, ...) char* subname I32 flags PREINIT: I32 i; PPCODE: for (i=0; i<items-2; i++) ST(i) = ST(i+2); /* pop first two args */ PUSHMARK(SP); SP += items - 2; PUTBACK; i = call_pv(subname, flags); SPAGAIN; EXTEND(SP, 1); PUSHs(sv_2mortal(newSViv(i)));

void call_argv(subname, flags, ...) char* subname I32 flags PREINIT: I32 i; char *args[8]; PPCODE: if (items > 8) /* play safe */ XSRETURN_UNDEF; for (i=2; i<items; i++) args[i-2] = SvPV_nolen(ST(i)); args[items-2] = NULL; PUTBACK; i = call_argv(subname, flags, args); SPAGAIN; EXTEND(SP, 1); PUSHs(sv_2mortal(newSViv(i)));

void call_method(methname, flags, ...) char* methname I32 flags PREINIT: I32 i; PPCODE: for (i=0; i<items-2; i++) ST(i) = ST(i+2); /* pop first two args */ PUSHMARK(SP); SP += items - 2; PUTBACK; i = call_method(methname, flags); SPAGAIN; EXTEND(SP, 1); PUSHs(sv_2mortal(newSViv(i)));

sub eq_array { my($a, $b) = @_; join(':', @$a) eq join(':', @$b); }

sub f { shift; unshift @_, 'b'; pop @_; @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; }

my $obj = bless [], 'Foo';

sub Foo::meth { return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo'; shift; shift; unshift @_, 'b'; pop @_; @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; }

my $test;

for $test ( # flags args expected description [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ], [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ], [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ], [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ], [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ], [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ], ) { my ($flags, $args, $expected, $description) = @$test; print "# --- $description ---\n"; ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected)); ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected)); ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected)); ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected)); ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected)); ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected)); ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected)); };

ok(&Devel::PPPort::eval_pv('f()', 0), 'y'); ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');