From: Vincent Pit <vince@profvince.com>
Date: Mon, 19 Apr 2010 22:09:38 +0000 (+0200)
Subject: Add sub_op_init(), sub_op_dup() and sub_op_free() to the API
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=commitdiff_plain;h=c987524f0641ca6a25d5e3072c9d1a2ecef2f57c

Add sub_op_init(), sub_op_dup() and sub_op_free() to the API
---

diff --git a/Makefile.PL b/Makefile.PL
index 333dac0..cc06573 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -71,7 +71,13 @@ WriteMakefile(
   PREOP    => "pod2text $file > \$(DISTVNAME)/README",
   COMPRESS => 'gzip -9f', SUFFIX => 'gz'
  },
- FUNCLIST         => [ qw/sub_op_register boot_Sub__Op/ ],
+ FUNCLIST         => [ qw[
+  boot_Sub__Op
+  sub_op_init
+  sub_op_register
+  sub_op_dup
+  sub_op_free
+ ] ],
  %ed_vars,
 );
 
diff --git a/Op.xs b/Op.xs
index 634ddc8..ecdac3a 100644
--- a/Op.xs
+++ b/Op.xs
@@ -113,6 +113,16 @@ typedef struct {
 
 #include "sub_op.h"
 
+void sub_op_init(sub_op_config_t *c) {
+ c->name    = NULL;
+ c->namelen = 0;
+ c->pp      = 0;
+ c->check   = 0;
+ c->ud      = NULL;
+
+ return;
+}
+
 void sub_op_register(pTHX_ const sub_op_config_t *c) {
  SV *key = newSViv(PTR2IV(c->pp));
 
@@ -136,6 +146,27 @@ void sub_op_register(pTHX_ const sub_op_config_t *c) {
  }
 }
 
+sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig) {
+ sub_op_config_t *dupe = PerlMemShared_malloc(sizeof *dupe);
+
+ dupe->namelen = orig->namelen;
+ dupe->name    = PerlMemShared_malloc(dupe->namelen);
+ Copy(orig->name, dupe->name, dupe->namelen, char);
+
+ dupe->pp      = orig->pp;
+ dupe->check   = orig->check;
+ dupe->ud      = orig->ud;
+
+ return dupe;
+}
+
+void sub_op_free(pTHX_ sub_op_config_t *c) {
+ PerlMemShared_free((char *) c->name);
+ PerlMemShared_free(c);
+
+ return;
+}
+
 /* --- Private helpers ----------------------------------------------------- */
 
 STATIC IV so_hint(pTHX) {
diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index 8b73256..cf67eac 100644
--- a/lib/Sub/Op.pm
+++ b/lib/Sub/Op.pm
@@ -50,6 +50,7 @@ In your XS file :
     BOOT:
     {
      sub_op_config_t c;
+     sub_op_init(&c);
      c.name    = "reftype";
      c.namelen = sizeof("reftype")-1;
      c.pp      = scalar_util_reftype;
@@ -246,12 +247,26 @@ An optional user data passed to the C<check> callback.
 
 =back
 
+=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)>
 
 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.
 
+=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
 
 =head2 C<enable $name, [ $pkg ]>
diff --git a/sub_op.h b/sub_op.h
index 77c899f..c594f03 100644
--- a/sub_op.h
+++ b/sub_op.h
@@ -14,6 +14,9 @@ typedef struct {
  void          *ud;
 } sub_op_config_t;
 
-void sub_op_register(pTHX_ const sub_op_config_t *c);
+void             sub_op_init    (sub_op_config_t *c);
+void             sub_op_register(pTHX_ const sub_op_config_t *c);
+sub_op_config_t *sub_op_dup     (pTHX_ const sub_op_config_t *c);
+void             sub_op_free    (pTHX_ sub_op_config_t *c);
 
 #endif /* SUB_OP_H */
diff --git a/t/Sub-Op-LexicalSub/LexicalSub.xs b/t/Sub-Op-LexicalSub/LexicalSub.xs
index a4d2d8e..c2b7002 100644
--- a/t/Sub-Op-LexicalSub/LexicalSub.xs
+++ b/t/Sub-Op-LexicalSub/LexicalSub.xs
@@ -62,6 +62,7 @@ PPCODE:
  if (SvROK(cb)) {
   cb = SvRV(cb);
   if (SvTYPE(cb) >= SVt_PVCV) {
+   sub_op_init(&c);
    c.name  = SvPV_const(name, c.namelen);
    c.check = sols_check;
    c.ud    = SvREFCNT_inc(cb);