This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix error in tryAMAGICunDEREF() introduced in 25a9ffce153b0e67.
authorNicholas Clark <nick@ccl4.org>
Tue, 9 Nov 2010 10:40:40 +0000 (10:40 +0000)
committerNicholas Clark <nick@ccl4.org>
Tue, 9 Nov 2010 10:40:40 +0000 (10:40 +0000)
tryAMAGICunDEREF() isn't used anywhere in the core. Add tests for it.

ext/XS-APItest/APItest.xs
ext/XS-APItest/t/overload.t
pp.h

index 3bad328..23dd963 100644 (file)
@@ -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:
index 1c391e9..7bb2a4d 100644 (file)
@@ -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");
+       }
     }
 }
 
diff --git a/pp.h b/pp.h
index 2122ba7..4e663ba 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -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