Changeset 14692

Timestamp:

06/27/08 14:44:08 (5 years ago)

Author:

yappo

Message:

できた

Location:

dan/perl/Object-with/branches/yappo

Files:

• lib/Object/with.pm (modified) (2 diffs)
• test.pl (modified) (2 diffs)
• with.xs (modified) (1 diff)

dan/perl/Object-with/branches/yappo/lib/Object/with.pm

@@ -27 +27 @@
 
     my @ret = $code->(@_);
-    # %TMP_METHOD_CACHE を片付ける
+
+    while (my($name, $code) = each %TMP_METHOD_CACHE) {
+        no strict 'refs';
+        no warnings 'redefine';
+        *{$name} = $code if $code && ref $code;
+        delete $TMP_METHOD_CACHE{$name};
+    }
 
     @ret;
@@ -39 +45 @@
     my $class   = ref($TMP_OBJ) || $TMP_OBJ;
 
-    warn "$name ( $class -> $method )";
-
     no strict 'refs';
     no warnings 'redefine';
 
-    $TMP_METHOD_CACHE{$name} = \&{$name};
+    $TMP_METHOD_CACHE{$name} = defined &{$name} ? \&{$name} : undef unless exists $TMP_METHOD_CACHE{$name};
     *{$name}                 = \&{"$class\::$method"};
-    use Data::Dumper;
 }
 

dan/perl/Object-with/branches/yappo/test.pl

@@ -3 +3 @@
 sub new { bless {} }
 sub hello { warn "hello" }
+sub hello2 { warn "hello2" }
 
 package main;
@@ -11 +12 @@
 use Object::with;
 
+
 my $o = MyObj->new;
 
 with $o => sub {
     hello();
+    hello2();
+    hello();
 };
+hello2();
 
+sub hello2 { die 'end' }
+exit;
+

dan/perl/Object-with/branches/yappo/with.xs

@@ -9 +9 @@
 
 OP * with_entersub(pTHX) {
-  dSP;
-  SV *sv = *sp;
+  dVAR; dSP;
+  SV * const name = *(PL_stack_base + TOPMARK + 1);
 
-  if (SvTYPE(sv) == SVt_PVGV) {
-    /*
+  if (SvTYPE(name) == SVt_PVGV) {
     ENTER;
     SAVETMPS;
     PUSHMARK(SP);
-    XPUSHs(sv);
+    XPUSHs(name);
     PUTBACK;
-    */
     call_pv("Object::with::_entersub", G_DISCARD);
-    /*
     FREETMPS;
     LEAVE;
-    */
+    
   }
-
   return PL_ppaddr[PL_op->op_type](aTHX);
 }