From: Vincent Pit 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/?a=commitdiff_plain;h=c987524f0641ca6a25d5e3072c9d1a2ecef2f57c;p=perl%2Fmodules%2FSub-Op.git 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 callback. =back +=head2 C + +Initializes the fields of the C 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 Registers a name and its configuration into L. The caller is responsible for allocating and freeing the C object. No pointer to it or to its members is kept. +=head2 C + +Deeply clones the specified C object. + +=head2 C + +Free the memory associated with the specified C object. + =head1 PERL API =head2 C 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);