diff options
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 33 | ||||
| -rw-r--r-- | ext/XS-APItest/t/overload.t | 49 | ||||
| -rw-r--r-- | pp.h | 2 |
3 files changed, 61 insertions, 23 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 3bad3286f2..23dd9637c6 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -923,6 +923,39 @@ amagic_deref_call(sv, what) /* The reference is owned by something else. */ PUSHs(amagic_deref_call(sv, what)); +# I'd certainly like to discourage the use of this macro, given that we now +# have amagic_deref_call + +SV * +tryAMAGICunDEREF_var(sv, what) + SV *sv + int what + PPCODE: + { + SV **sp = &sv; + switch(what) { + case to_av_amg: + tryAMAGICunDEREF(to_av); + break; + case to_cv_amg: + tryAMAGICunDEREF(to_cv); + break; + case to_gv_amg: + tryAMAGICunDEREF(to_gv); + break; + case to_hv_amg: + tryAMAGICunDEREF(to_hv); + break; + case to_sv_amg: + tryAMAGICunDEREF(to_sv); + break; + default: + croak("Invalid value %d passed to tryAMAGICunDEREF_var", what); + } + } + /* The reference is owned by something else. */ + PUSHs(sv); + MODULE = XS::APItest PACKAGE = XS::APItest::XSUB BOOT: diff --git a/ext/XS-APItest/t/overload.t b/ext/XS-APItest/t/overload.t index 1c391e9701..7bb2a4d8c7 100644 --- a/ext/XS-APItest/t/overload.t +++ b/ext/XS-APItest/t/overload.t @@ -57,29 +57,34 @@ my @ref = (['unblessed SV', do {\my $whap}], ); while (my ($type, $enum) = each %types) { - foreach (@non_ref, @ref, + foreach ([amagic_deref_call => \&amagic_deref_call], + [tryAMAGICunDEREF_var => \&tryAMAGICunDEREF_var], ) { - my ($desc, $input) = @$_; - my $got = amagic_deref_call($input, $enum); - is($got, $input, "Expect no change for to_$type $desc"); - } - foreach (@non_ref) { - my ($desc, $sucker) = @$_; - my $input = bless [$sucker], 'Chain'; - is(eval {amagic_deref_call($input, $enum)}, undef, - "Chain to $desc for to_$type"); - like($@, qr/Overloaded dereference did not return a reference/, - 'expected error'); - } - foreach (@ref, - ) { - my ($desc, $sucker) = @$_; - my $input = bless [$sucker], 'Chain'; - my $got = amagic_deref_call($input, $enum); - is($got, $sucker, "Chain to $desc for to_$type"); - $input = bless [bless [$sucker], 'Chain'], 'Chain'; - my $got = amagic_deref_call($input, $enum); - is($got, $sucker, "Chain to chain to $desc for to_$type"); + my ($name, $func) = @$_; + foreach (@non_ref, @ref, + ) { + my ($desc, $input) = @$_; + my $got = &$func($input, $enum); + is($got, $input, "$name: expect no change for to_$type $desc"); + } + foreach (@non_ref) { + my ($desc, $sucker) = @$_; + my $input = bless [$sucker], 'Chain'; + is(eval {&$func($input, $enum)}, undef, + "$name: chain to $desc for to_$type"); + like($@, qr/Overloaded dereference did not return a reference/, + 'expected error'); + } + foreach (@ref, + ) { + my ($desc, $sucker) = @$_; + my $input = bless [$sucker], 'Chain'; + my $got = &$func($input, $enum); + is($got, $sucker, "$name: chain to $desc for to_$type"); + $input = bless [bless [$sucker], 'Chain'], 'Chain'; + my $got = &$func($input, $enum); + is($got, $sucker, "$name: chain to chain to $desc for to_$type"); + } } } @@ -453,7 +453,7 @@ Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>. calling amagic_deref_call() directly, as it has a cleaner interface. */ #define tryAMAGICunDEREF(meth) \ STMT_START { \ - sv = amagic_deref_call(aTHX_ *sp, CAT2(meth,_amg)); \ + sv = amagic_deref_call(*sp, CAT2(meth,_amg)); \ SPAGAIN; \ } STMT_END |