Change 33777: [PATCH] ~~ with non-overloaded objects

[Rafael Garcia-Suarez]

Change 33777 by [EMAIL PROTECTED] on 2008/05/02 11:07:19

        Subject: [PATCH] ~~ with non-overloaded objects
        From: "Vincent Pit" <[EMAIL PROTECTED]>
        Date: Thu, 1 May 2008 12:45:51 +0200 (CEST)
        Message-ID: <[EMAIL PROTECTED]>

Affected files ...

... //depot/perl/pp_ctl.c#691 edit
... //depot/perl/t/op/smobj.t#2 edit

Differences ...

==== //depot/perl/pp_ctl.c#691 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#690~33685~    2008-04-15 05:29:33.000000000 -0700
+++ perl/pp_ctl.c       2008-05-02 04:07:19.000000000 -0700
@@ -4012,6 +4012,11 @@
        && (Other = d)) )
        
 
+#   define SM_OBJECT ( \
+          (sv_isobject(d) && (SvTYPE(SvRV(d)) != SVt_REGEXP))          \
+    ||                                                                 \
+          (sv_isobject(e) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) )        \
+
 #   define SM_OTHER_REF(type) \
        (SvROK(Other) && SvTYPE(SvRV(Other)) == SVt_##type)
 
@@ -4043,6 +4048,9 @@
     if (SvGMAGICAL(e))
        e = sv_mortalcopy(e);
 
+    if (SM_OBJECT)
+       Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks 
encapsulation");
+
     if (SM_CV_NEP) {
        I32 c;
        

==== //depot/perl/t/op/smobj.t#2 (text) ====
Index: perl/t/op/smobj.t
--- perl/t/op/smobj.t#1~33750~  2008-04-26 14:22:56.000000000 -0700
+++ perl/t/op/smobj.t   2008-05-02 04:07:19.000000000 -0700
@@ -6,11 +6,14 @@
     require './test.pl';
 }
 
-plan tests => 5;
+plan tests => 11;
 
 use strict;
 use warnings;
 
+
+my @tests = ('$obj ~~ "key"', '"key" ~~ $obj', '$obj ~~ $obj');
+
 {
     package Test::Object::NoOverload;
     sub new { bless { key => 1 } }
@@ -19,20 +22,18 @@
 {
     my $obj = Test::Object::NoOverload->new;
     isa_ok($obj, 'Test::Object::NoOverload');
-    my $r = eval { ($obj ~~ 'key') };
-
-    local $::TODO = 'To be implemented';
-
-    ok(
-       ! defined $r,
-       "we do not smart match against an object's underlying implementation",
-    );
-
-    like(
-       $@,
-       qr/overload/,
-       "we die when smart matching an obj with no ~~ overload",
-    );
+    for (@tests) {
+       my $r = eval;
+       ok(
+           ! defined $r,
+           "we do not smart match against an object's underlying 
implementation",
+       );
+       like(
+           $@,
+           qr/overload/,
+           "we die when smart matching an obj with no ~~ overload",
+       );
+    }
 }
 
 {
@@ -44,5 +45,5 @@
 {
     my $obj = Test::Object::CopyOverload->new;
     isa_ok($obj, 'Test::Object::CopyOverload');
-    ok($obj ~~ 'key', 'we are able to make an object ~~ overload');
+    ok(eval, 'we are able to make an object ~~ overload') for @tests;
 }
End of Patch.