X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FSub%2FOp.pm;h=8b7325658143c7f5ac1763b84c11c8a5649ea813;hb=50984c4a3e39b187b5b52ceeba826bc819d23564;hp=0085cb1eadd14bb8ba4d68ab1a8fc2b645cde6bc;hpb=bef3694f4167eacd3fe677e5f72228aa3023686b;p=perl%2Fmodules%2FSub-Op.git

diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index 0085cb1..8b73256 100644
--- a/lib/Sub/Op.pm
+++ b/lib/Sub/Op.pm
@@ -11,7 +11,7 @@ Sub::Op - Install subroutines as opcodes.
 
 =head1 VERSION
 
-Version 0.01
+Version 0.02
 
 =cut
 
@@ -20,7 +20,7 @@ our ($VERSION, @ISA);
 sub dl_load_flags { 0x01 }
 
 BEGIN {
- $VERSION = '0.01';
+ $VERSION = '0.02';
  require DynaLoader;
  push @ISA, 'DynaLoader';
  __PACKAGE__->bootstrap($VERSION);
@@ -50,11 +50,11 @@ In your XS file :
     BOOT:
     {
      sub_op_config_t c;
-     c.name  = "reftype";
-     c.len   = sizeof("reftype")-1;
-     c.pp    = scalar_util_reftype;
-     c.check = 0;
-     c.ud    = NULL;
+     c.name    = "reftype";
+     c.namelen = sizeof("reftype")-1;
+     c.pp      = scalar_util_reftype;
+     c.check   = 0;
+     c.ud      = NULL;
      sub_op_register(aTHX_ &c);
     }
 
@@ -142,8 +142,14 @@ my $sw = Variable::Magic::wizard(
   my $pkg = $data->{pkg};
   my $fqn = join '::', $pkg, $name;
 
-  no strict 'refs';
-  *$fqn = $placeholder unless exists &$fqn;
+  {
+   local $SIG{__WARN__} = sub {
+    CORE::warn(@_) unless $_[0] =~ /^Constant subroutine.*redefined/;
+   } if _constant_sub(do { no strict 'refs'; \&$fqn });
+   no strict 'refs';
+   no warnings 'redefine';
+   *$fqn = $placeholder;
+  }
 
   return;
  },
@@ -155,6 +161,7 @@ sub _tag {
  my $fqn = join '::', $pkg, $name;
 
  return {
+  old   => _defined_sub($fqn) ? \&$fqn : undef,
   proto => prototype($fqn),
  };
 }
@@ -208,7 +215,7 @@ Allowed to be static.
 
 =item *
 
-C<STRLEN len>
+C<STRLEN namelen>
 
 C<name>'s length, in bytes.
 
@@ -296,11 +303,22 @@ sub disable {
  my $pkg = @_ > 0 ? $_[0] : caller;
  my $map = _map($pkg);
 
+ my $fqn = join '::', $pkg, $name;
+
  if (defined $map) {
-  my $proto = $map->{$name}->{proto};
+  my $tag = $map->{$name};
+
+  my $old = $tag->{old};
+  if (defined $old) {
+   no strict 'refs';
+   no warnings 'redefine';
+   *$fqn = $old;
+  }
+
+  my $proto = $tag->{proto};
   if (defined $proto) {
    no strict 'refs';
-   Scalar::Util::set_prototype(\&{"${pkg}::$name"}, $proto);
+   Scalar::Util::set_prototype(\&$fqn, $proto);
   }
 
   delete $map->{$name};
@@ -417,6 +435,14 @@ BEGIN { _monkeypatch() }
 
 See the F<t/Sub-Op-LexicalSub> directory that implements a complete example.
 
+=head1 CAVEATS
+
+Preexistent definitions of a sub whose name is handled by L<Sub::Op> are restored at the end of the lexical scope in which the module is used.
+But if you define a sub in the scope of action of L<Sub::Op> with a name that is currently being replaced, the new declaration will be obliterated at the scope end.
+
+Function calls without parenthesis inside an C<eval STRING> in the scope of the pragma won't be replaced.
+I know a few ways of fixing this, but I've not yet decided on which.
+
 =head1 DEPENDENCIES
 
 L<perl> 5.10.
@@ -429,6 +455,10 @@ L<ExtUtils::Depends>.
 
 L<subs::auto>.
 
+L<B::Hooks::XSUB::CallAsOp> provides a C API to declare XSUBs that effectively call a specific PP function.
+Thus, it allows you to write XSUBs with the PP stack conventions used for implementing perl core keywords.
+There's no opcode replacement and no parsing hacks.
+
 L<B::Hooks::OP::Check::EntersubForCV>.
 
 =head1 AUTHOR