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) \
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);
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)) )
{
# 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}
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
}
# 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")
}
{
my $ok = 0;
given("foo") {
- when(main->bar()) {$ok = 1}
+ when(main->notfoo()) {$ok = 1}
}
ok($ok, "Class-method call acts as boolean")
}
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")
}
{
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 {