Remove special case for coderefs with empty prototypes in smart match
Rafael Garcia-Suarez [Fri, 6 Mar 2009 14:57:21 +0000 (15:57 +0100)]
(plus, fix a metasyntactic name clash in the switch test)

pp_ctl.c
t/op/smartmatch.t
t/op/switch.t

index f512832..33ac1ee 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4029,18 +4029,10 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
     SV *This, *Other;  /* 'This' (and Other to match) to play with C++ */
     REGEXP *this_regex, *other_regex;
 
-#   define NOT_EMPTY_PROTO(cv) (!SvPOK(cv) || SvCUR(cv) == 0)
-
 #   define SM_REF(type) ( \
           (SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_##type) && (Other = e)) \
        || (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_##type) && (Other = d)))
 
-#   define SM_CV_NEP   /* Find a code ref without an empty prototype */ \
-       ((SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_PVCV)              \
-           && NOT_EMPTY_PROTO(This) && (Other = e))                    \
-       || (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_PVCV)            \
-           && NOT_EMPTY_PROTO(This) && (Other = d)))
-
 #   define SM_REGEX ( \
           (SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP)          \
        && (this_regex = (REGEXP*) This)                                \
@@ -4094,17 +4086,8 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
            Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation");
     }
 
-    if (SM_CV_NEP) {
+    if (SM_REF(PVCV)) {
        I32 c;
-       
-       if ( SM_OTHER_REF(PVCV) && NOT_EMPTY_PROTO(SvRV(Other)) )
-       {
-           if (This == SvRV(Other))
-               RETPUSHYES;
-           else
-               RETPUSHNO;
-       }
-       
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);
@@ -4338,42 +4321,6 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        destroy_matcher(matcher);
        RETURN;
     }
-    else if (SM_REF(PVCV)) {
-       I32 c;
-       /* This must be a null-prototyped sub, because we
-          already checked for the other kind. */
-       
-       ENTER;
-       SAVETMPS;
-       PUSHMARK(SP);
-       PUTBACK;
-       c = call_sv(This, G_SCALAR);
-       SPAGAIN;
-       if (c == 0)
-           PUSHs(&PL_sv_undef);
-       else if (SvTEMP(TOPs))
-           SvREFCNT_inc_void(TOPs);
-
-       if (SM_OTHER_REF(PVCV)) {
-           /* This one has to be null-proto'd too.
-              Call both of 'em, and compare the results */
-           PUSHMARK(SP);
-           c = call_sv(SvRV(Other), G_SCALAR);
-           SPAGAIN;
-           if (c == 0)
-               PUSHs(&PL_sv_undef);
-           else if (SvTEMP(TOPs))
-               SvREFCNT_inc_void(TOPs);
-           FREETMPS;
-           LEAVE;
-           PUTBACK;
-           return pp_eq();
-       }
-       
-       FREETMPS;
-       LEAVE;
-       RETURN;
-    }
     else if ( ((SvIOK(d) || SvNOK(d)) && (This = d) && (Other = e))
          ||   ((SvIOK(e) || SvNOK(e)) && (This = e) && (Other = d)) )
     {
index fcacd76..685216d 100644 (file)
@@ -157,12 +157,7 @@ __DATA__
 
 # CODE ref against argument
 #  - arg is code ref
-       \&foo           \&foo
 !      \&foo           sub {}
-!      \&foo           sub { "$_[0]" =~ /^CODE/ }
-!      \&foo           \&bar
-       \&fatal         \&fatal
-!      \&foo           \&fatal
 
 # - arg is not code ref
        1       sub{shift}
@@ -194,25 +189,15 @@ __DATA__
        a_const         "a constant"
        a_const         a_const
        a_const         b_const
-       \&a_const       \&a_const
-!      \&a_const       \&b_const
 !      undef           \&FALSE
        undef           \&TRUE
 !      0               \&FALSE
        0               \&TRUE
 !      1               \&FALSE
        1               \&TRUE
-       \&FALSE         \&FALSE
 !      \&FALSE         \&foo
-!      \&FALSE         \&bar
-!      \&TRUE          \&foo
-!      \&TRUE          \&bar
-!      \&TWO           \&foo
-!      \&TWO           \&bar
-       \&FALSE         \&FALSE
 
 # - non-null-prototyped subs
-!      \&bar           \&gorch
        bar             gorch
 @      fatal           bar
 
index e01ce2f..b00ade8 100644 (file)
@@ -428,11 +428,11 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
 }
 
 # Sub and method calls
-sub bar {"bar"}
+sub notfoo {"bar"}
 {
     my $ok = 0;
     given("foo") {
-       when(bar()) {$ok = 1}
+       when(notfoo()) {$ok = 1}
     }
     ok($ok, "Sub call acts as boolean")
 }
@@ -440,7 +440,7 @@ sub bar {"bar"}
 {
     my $ok = 0;
     given("foo") {
-       when(main->bar()) {$ok = 1}
+       when(main->notfoo()) {$ok = 1}
     }
     ok($ok, "Class-method call acts as boolean")
 }
@@ -449,7 +449,7 @@ sub bar {"bar"}
     my $ok = 0;
     my $obj = bless [];
     given("foo") {
-       when($obj->bar()) {$ok = 1}
+       when($obj->notfoo()) {$ok = 1}
     }
     ok($ok, "Object-method call acts as boolean")
 }
@@ -721,18 +721,18 @@ my $f = tie my $v, "FetchCounter";
 {
     no warnings "redefine";
     my $called_foo = 0;
-    sub foo {$called_foo = 1}
+    sub foo {$called_foo = 1; "@_" eq "foo"}
     my $called_bar = 0;
-    sub bar {$called_bar = 1}
+    sub bar {$called_bar = 1; "@_" eq "bar"}
     my ($matched_foo, $matched_bar) = (0, 0);
-    given(\&foo) {
+    given("foo") {
        when(\&bar) {$matched_bar = 1}
        when(\&foo) {$matched_foo = 1}
     }
-    is($called_foo, 0,  "Code ref comparison: foo not called");
-    is($called_bar, 0,  "Code ref comparison: bar not called");
-    is($matched_bar, 0, "Code ref didn't match different one");
-    is($matched_foo, 1, "Code ref did match itself");
+    is($called_foo, 1,  "foo() was called");
+    is($called_bar, 1,  "bar() was called");
+    is($matched_bar, 0, "bar didn't match");
+    is($matched_foo, 1, "foo did match");
 }
 
 sub contains_x {