Skip Menu |

This queue is for tickets about the Sentinel CPAN distribution.

Report information
The Basics
Id: 118154
Status: patched
Priority: 0/
Queue: Sentinel

People
Owner: Nobody in particular
Requestors: RANDIR [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: Module is not thread-safe
use strict; use Sentinel; use threads; sub wibble :lvalue { sentinel obj => shift, get => sub {1}; } { my $bar; my $sent = \wibble($bar); threads->create(sub{ my $foo = $$sent for (1..50_000); }) for (1..2); warn 1; } sleep 1; =cut This fails for me in ~75% of runs. If it doesn't for you, just insert a delay between threads creation and scope exit (here "warn" serves just for that purpose).
Here's a patch for it. But I have one question - you copied all incoming values (get_cb/set_cb/obj), but what was the purpose? In the end, I've left only 'obj' being copied, as it makes for me at least some sense, but i'd probably copy nothing at all. === modified file 'lib/Sentinel.xs' --- lib/Sentinel.xs 2012-05-30 13:18:36 +0000 +++ lib/Sentinel.xs 2016-09-29 22:07:36 +0000 @@ -8,18 +8,23 @@ #include "perl.h" #include "XSUB.h" +#ifndef SvREFCNT_inc_simple +#define SvREFCNT_inc_simple SvREFCNT_inc +#endif + #include <string.h> #define streq(a,b) (strcmp((a),(b)) == 0) typedef struct { SV *get_cb; SV *set_cb; + SV *obj; } sentinel_ctx; static int magic_get(pTHX_ SV *sv, MAGIC *mg) { dSP; - sentinel_ctx *ctx = (void *)mg->mg_ptr; + sentinel_ctx *ctx = (sentinel_ctx*)AvARRAY(mg->mg_obj); if(ctx->get_cb) { int count; @@ -28,11 +33,11 @@ SAVETMPS; PUSHMARK(SP); - if(mg->mg_obj) - PUSHs(mg->mg_obj); + if(ctx->obj) + PUSHs(ctx->obj); PUTBACK; - if(mg->mg_obj && SvPOK(ctx->get_cb)) + if(ctx->obj && SvPOK(ctx->get_cb)) // Calling method by name count = call_method(SvPV_nolen(ctx->get_cb), G_SCALAR); else @@ -53,19 +58,19 @@ static int magic_set(pTHX_ SV *sv, MAGIC *mg) { dSP; - sentinel_ctx *ctx = (void *)mg->mg_ptr; + sentinel_ctx *ctx = (sentinel_ctx*)AvARRAY(mg->mg_obj); if(ctx->set_cb) { ENTER; SAVETMPS; PUSHMARK(SP); - if(mg->mg_obj) - PUSHs(mg->mg_obj); + if(ctx->obj) + PUSHs(ctx->obj); PUSHs(sv); PUTBACK; - if(mg->mg_obj && SvPOK(ctx->set_cb)) + if(ctx->obj && SvPOK(ctx->set_cb)) // Calling method by name call_method(SvPV_nolen(ctx->set_cb), G_VOID); else @@ -80,26 +85,9 @@ return 1; } -static int magic_free(pTHX_ SV *sv, MAGIC *mg) -{ - sentinel_ctx *ctx = (void *)mg->mg_ptr; - - if(ctx->get_cb) - SvREFCNT_dec(ctx->get_cb); - if(ctx->set_cb) - SvREFCNT_dec(ctx->set_cb); - - Safefree(ctx); - - return 1; -} - static MGVTBL vtbl = { &magic_get, &magic_set, - NULL, /* len */ - NULL, /* clear */ - &magic_free, }; MODULE = Sentinel PACKAGE = Sentinel @@ -137,8 +125,7 @@ } } - retval = newSV(0); - sv_2mortal(retval); + retval = sv_newmortal(); /** * Perl 5.14 allows any TEMP scalar to be returned in LVALUE context provided * it is magical. Perl versions before this only accept magic for being a tied @@ -155,15 +142,18 @@ if(get_cb || set_cb) { sentinel_ctx *ctx; - Newx(ctx, 1, sentinel_ctx); - - ctx->get_cb = newSVsv(get_cb); - ctx->set_cb = newSVsv(set_cb); - - if(obj) - obj = sv_mortalcopy(obj); - - sv_magicext(retval, obj, PERL_MAGIC_ext, &vtbl, (char *)ctx, 0); + AV* payload = newAV(); + av_extend(payload, 2); + AvFILLp(payload) = 2; + + ctx = (sentinel_ctx*)AvARRAY(payload); + + ctx->get_cb = SvREFCNT_inc_simple(get_cb); + ctx->set_cb = SvREFCNT_inc_simple(set_cb); + ctx->obj = obj ? newSVsv(obj) : NULL; + + sv_magicext(retval, (SV*)payload, PERL_MAGIC_ext, &vtbl, NULL, 0); + SvREFCNT_dec(payload); } PUSHs(retval);
On Thu Sep 29 18:12:33 2016, RANDIR wrote: Show quoted text
> Here's a patch for it. But I have one question - you copied all > incoming values (get_cb/set_cb/obj), but what was the purpose? In the > end, I've left only 'obj' being copied, as it makes for me at least > some sense, but i'd probably copy nothing at all.
Stack isn't refcounted and weird variable aliasing might make things break like my $obj = ...; sentinel( obj => $obj ); undef $obj; It's best to newSVsv() even the callbacks in that case, otherwise sentinel( ..., get_cb => $cb ) undef $cb also breaks -- Paul Evans
Patch applied; ish. I didn't quite like aliasing the AvARRAY with a three-SV* struct so instead I typedefed it as an SV** and made an enum for the first three indices. -- Paul Evans
Subject: rt118154.patch
=== modified file 'lib/Sentinel.xs' --- lib/Sentinel.xs 2012-05-30 13:18:36 +0000 +++ lib/Sentinel.xs 2019-01-14 20:37:17 +0000 @@ -11,32 +11,35 @@ #include <string.h> #define streq(a,b) (strcmp((a),(b)) == 0) -typedef struct { - SV *get_cb; - SV *set_cb; -} sentinel_ctx; +enum { + CTX_GET_CB, + CTX_SET_CB, + CTX_OBJ, +}; + +typedef SV *sentinel_ctx; static int magic_get(pTHX_ SV *sv, MAGIC *mg) { dSP; - sentinel_ctx *ctx = (void *)mg->mg_ptr; + sentinel_ctx *ctx = (sentinel_ctx*)AvARRAY(mg->mg_obj); - if(ctx->get_cb) { + if(ctx[CTX_GET_CB]) { int count; ENTER; SAVETMPS; PUSHMARK(SP); - if(mg->mg_obj) - PUSHs(mg->mg_obj); + if(ctx[CTX_OBJ]) + PUSHs(ctx[CTX_OBJ]); PUTBACK; - if(mg->mg_obj && SvPOK(ctx->get_cb)) + if(ctx[CTX_OBJ] && SvPOK(ctx[CTX_GET_CB])) // Calling method by name - count = call_method(SvPV_nolen(ctx->get_cb), G_SCALAR); + count = call_method(SvPV_nolen(ctx[CTX_GET_CB]), G_SCALAR); else - count = call_sv(ctx->get_cb, G_SCALAR); + count = call_sv(ctx[CTX_GET_CB], G_SCALAR); assert(count == 1); SPAGAIN; @@ -53,23 +56,23 @@ static int magic_set(pTHX_ SV *sv, MAGIC *mg) { dSP; - sentinel_ctx *ctx = (void *)mg->mg_ptr; + sentinel_ctx *ctx = (sentinel_ctx*)AvARRAY(mg->mg_obj); - if(ctx->set_cb) { + if(ctx[CTX_SET_CB]) { ENTER; SAVETMPS; PUSHMARK(SP); - if(mg->mg_obj) - PUSHs(mg->mg_obj); + if(ctx[CTX_OBJ]) + PUSHs(ctx[CTX_OBJ]); PUSHs(sv); PUTBACK; - if(mg->mg_obj && SvPOK(ctx->set_cb)) + if(ctx[CTX_OBJ] && SvPOK(ctx[CTX_SET_CB])) // Calling method by name - call_method(SvPV_nolen(ctx->set_cb), G_VOID); + call_method(SvPV_nolen(ctx[CTX_SET_CB]), G_VOID); else - call_sv(ctx->set_cb, G_VOID); + call_sv(ctx[CTX_SET_CB], G_VOID); SPAGAIN; @@ -80,26 +83,9 @@ return 1; } -static int magic_free(pTHX_ SV *sv, MAGIC *mg) -{ - sentinel_ctx *ctx = (void *)mg->mg_ptr; - - if(ctx->get_cb) - SvREFCNT_dec(ctx->get_cb); - if(ctx->set_cb) - SvREFCNT_dec(ctx->set_cb); - - Safefree(ctx); - - return 1; -} - static MGVTBL vtbl = { &magic_get, &magic_set, - NULL, /* len */ - NULL, /* clear */ - &magic_free, }; MODULE = Sentinel PACKAGE = Sentinel @@ -137,8 +123,7 @@ } } - retval = newSV(0); - sv_2mortal(retval); + retval = sv_newmortal(); /** * Perl 5.14 allows any TEMP scalar to be returned in LVALUE context provided * it is magical. Perl versions before this only accept magic for being a tied @@ -155,15 +140,18 @@ if(get_cb || set_cb) { sentinel_ctx *ctx; - Newx(ctx, 1, sentinel_ctx); - - ctx->get_cb = newSVsv(get_cb); - ctx->set_cb = newSVsv(set_cb); - - if(obj) - obj = sv_mortalcopy(obj); - - sv_magicext(retval, obj, PERL_MAGIC_ext, &vtbl, (char *)ctx, 0); + AV* payload = newAV(); + av_extend(payload, 2); + AvFILLp(payload) = 2; + + ctx = (sentinel_ctx*)AvARRAY(payload); + + ctx[CTX_GET_CB] = get_cb ? newSVsv(get_cb) : NULL; + ctx[CTX_SET_CB] = set_cb ? newSVsv(set_cb) : NULL; + ctx[CTX_OBJ] = obj ? newSVsv(obj) : NULL; + + sv_magicext(retval, (SV*)payload, PERL_MAGIC_ext, &vtbl, NULL, 0); + SvREFCNT_dec(payload); } PUSHs(retval);