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 cf67eac9e5317a8f7f984798d8fb3cbb134ca3e6..a0f25a9473d31ab4b9e82f847e020d5471fcbb73 100644 (file)
--- a/lib/Sub/Op.pm
+++ b/lib/Sub/Op.pm
@@ -51,12 +51,14 @@ In your XS file :
     {
      sub_op_config_t c;
      sub_op_init(&c);
     {
      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;
-     sub_op_register(aTHX_ &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 :
     }
 
 In your Perl module file :


@@ -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';
     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;
   }
 
    *$fqn = $placeholder;
   }
 

+  {
+   my $proto = _get_prototype($name);
+   no strict 'refs';
+   Scalar::Util::set_prototype(\&$fqn, $proto);
+  }
+

   return;
  },
 );
   return;
  },
 );


@@ -222,6 +230,19 @@ C<name>'s length, in bytes.
 
 =item *
 
 
 =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.
 C<Perl_ppaddr_t pp>
 
 The pp function that will be called instead of the subroutine.


@@ -253,11 +274,11 @@ 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.
 
 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)>
+=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.
 
 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)>
 
 
 =head2 C<sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig)>