X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=blobdiff_plain;f=lib%2FSub%2FOp.pm;h=a0f25a9473d31ab4b9e82f847e020d5471fcbb73;hp=44b3e9b671d5379b1374f63496e3df64958ed899;hb=32384f24279ef75bc0b95279c093cf90d8c47195;hpb=984cdc340cbc0920a576e89f27fe9ea3ea50feba

diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index 44b3e9b..a0f25a9 100644
--- a/lib/Sub/Op.pm
+++ b/lib/Sub/Op.pm
@@ -51,11 +51,13 @@ In your XS file :
     {
      sub_op_config_t c;
      sub_op_init(&c);
-     c.name    = "reftype";
-     c.namelen = sizeof("reftype")-1;
-     c.pp      = scalar_util_reftype;
-     c.check   = 0;
-     c.ud      = NULL;
+     c.name     = "reftype";
+     c.namelen  = sizeof("reftype")-1;
+     c.proto    = "$";
+     c.protolen = sizeof("$")-1;
+     c.pp       = scalar_util_reftype;
+     c.check    = 0;
+     c.ud       = NULL;
      sub_op_register(aTHX_ &c, 0);
     }
 
@@ -148,10 +150,16 @@ my $sw = Variable::Magic::wizard(
     CORE::warn(@_) unless $_[0] =~ /^Constant subroutine.*redefined/;
    } if _constant_sub(do { no strict 'refs'; \&$fqn });
    no strict 'refs';
-   no warnings 'redefine';
+   no warnings qw/prototype redefine/;
    *$fqn = $placeholder;
   }
 
+  {
+   my $proto = _get_prototype($name);
+   no strict 'refs';
+   Scalar::Util::set_prototype(\&$fqn, $proto);
+  }
+
   return;
  },
 );
@@ -222,6 +230,19 @@ C<name>'s length, in bytes.
 
 =item *
 
+C<const char *proto>
+
+The prototype you want to apply to the subroutine, or C<NULL> if none.
+Allowed to be static.
+
+=item *
+
+C<STRLEN protolen>
+
+C<proto>'s length, in bytes.
+
+=item *
+
 C<Perl_ppaddr_t pp>
 
 The pp function that will be called instead of the subroutine.