Add support for prototypes

[perl/modules/Sub-Op.git] / lib / Sub / Op.pm

diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index 6b421c4be5a17f3f6b3a9a2f91e63386c48f53b5..a0f25a9473d31ab4b9e82f847e020d5471fcbb73 100644 (file)
--- 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,12 +50,15 @@ In your XS file :
     BOOT:
     {
      sub_op_config_t c;
-     c.name    = "reftype";
-     c.namelen = sizeof("reftype")-1;
-     c.pp      = scalar_util_reftype;
-     c.check   = 0;
-     c.ud      = NULL;
-     sub_op_register(aTHX_ &c);
+     sub_op_init(&c);
+     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);
     }
 
 In your Perl module file :
@@ -147,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;
  },
 );
@@ -221,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.
@@ -246,11 +268,25 @@ An optional user data passed to the C<check> callback.
 
 =back
 
-=head2 C<void sub_op_register(pTHX_ const sub_op_config_t *c)>
+=head2 C<void sub_op_init(sub_op_config_t *c)>
+
+Initializes the fields of the C<sub_op_config_t> object.
+For future compatibility, it is required to call this function with your config object before storing your actual values.
+It will store safe defaults for members you won't set.
+
+=head2 C<void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags)>
 
 Registers a name and its configuration into L<Sub::Op>.
 The caller is responsible for allocating and freeing the C<sub_op_config_t> object.
-No pointer to it or to its members is kept.
+No pointer to it or to its members is kept, except if you pass the flag C<SUB_OP_REGISTER_STEAL> in which case the configuration object will be stolen to be stored into L<Sub::Op>'s internal datastructure.
+
+=head2 C<sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig)>
+
+Deeply clones the specified C<sub_op_config_t> object.
+
+=head2 C<void sub_op_free(pTHX_ sub_op_config_t *c)>
+
+Free the memory associated with the specified C<sub_op_config_t> object.
 
 =head1 PERL API
 
@@ -435,6 +471,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.