File Coverage

lib/Object/Pad/SlotAttr/LazyInit.xs

Criterion	Covered	Total	%
statement	44	47	93.6
branch	16	28	57.1
condition			n/a
subroutine			n/a
pod			n/a
total	60	75	80.0

line	stmt	bran	code
1			/* You may distribute under the terms of either the GNU General Public License
2			* or the Artistic License (the same terms as Perl itself)
3			*
4			* (C) Paul Evans, 2021 -- leonerd@leonerd.org.uk
5			*/
6			#define PERL_NO_GET_CONTEXT
7
8			#include "EXTERN.h"
9			#include "perl.h"
10			#include "XSUB.h"
11
12			#include "object_pad.h"
13
14			static SV *unassigned_val;
15
16			#ifndef mg_freeext
17			# define mg_freeext(sv, how, vtbl) S_mg_freeext(aTHX_ sv, how, vtbl)
18	4		static void S_mg_freeext(pTHX_ SV sv, int how, const MGVTBL vtbl)
19			{
20			MAGIC mg, prevmg, *moremg;
21
22			assert(how == PERL_MAGIC_ext);
23
24	8	100	for(prevmg = NULL, mg = SvMAGIC(sv); mg; prevmg = mg, mg = moremg) {
25	4		moremg = mg->mg_moremagic;
26	4	50	if(mg->mg_type == how && mg->mg_virtual == vtbl) {
		50
27	4	50	if(prevmg) {
28	0		prevmg->mg_moremagic = moremg;
29			}
30			else {
31	4		SvMAGIC_set(sv, moremg);
32			}
33
34			/* mg_free_struct(sv, mg) */
35	4	50	if(vtbl->svt_free)
36	0		vtbl->svt_free(aTHX_ sv, mg);
37	4	50	if(mg->mg_ptr) {
38	4	50	if(mg->mg_len > 0)
39	0		Safefree(mg->mg_ptr);
40	4	50	else if(mg->mg_len == HEf_SVKEY)
41			SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
42			}
43	4	50	if(mg->mg_flags & MGf_REFCOUNTED)
44	4		SvREFCNT_dec(mg->mg_obj);
45			}
46			}
47	4		}
48			#endif
49
50			static int magic_get(pTHX_ SV sv, MAGIC mg);
51			static int magic_set(pTHX_ SV sv, MAGIC mg);
52
53			static const MGVTBL vtbl = {
54			.svt_get = &magic_get,
55			.svt_set = &magic_set,
56			};
57
58	2		static int magic_get(pTHX_ SV sv, MAGIC mg)
59			{
60	2		SV *self = mg->mg_obj;
61	2		SV methodname = (SV )mg->mg_ptr;
62
63	2		dSP;
64
65	2		ENTER;
66	2		SAVETMPS;
67
68	2	50	PUSHMARK(SP);
69	2		PUSHs(self);
70	2		PUTBACK;
71
72	2	50	call_method(SvPV_nolen(methodname), G_SCALAR);
73
74	2		SPAGAIN;
75
76	2		SV *value = POPs;
77
78	2		sv_setsv_nomg(sv, value);
79
80	2	50	FREETMPS;
81	2		LEAVE;
82
83			/* Now disarm the magic so it won't run again */
84	2		mg_freeext(sv, PERL_MAGIC_ext, &vtbl);
85
86	2		return 1;
87			}
88
89	5		static int magic_set(pTHX_ SV sv, MAGIC mg)
90			{
91	5	100	if(SvROK(sv) && SvRV(sv) == unassigned_val)
		50
92			/* This is just the constructor applying the default unassigned value;
93			* don't disarm the magic yet
94			*/
95			return 1;
96
97			/* Now disarm the magic so it won't run again */
98	2		mg_freeext(sv, PERL_MAGIC_ext, &vtbl);
99
100	2		return 1;
101			}
102
103	1		static bool lazyinit_apply(pTHX_ SlotMeta slotmeta, SV value, SV *hookdata_ptr, void _funcdata)
104			{
105	1		mop_slot_set_default_sv(slotmeta, newRV_inc(unassigned_val));
106
107	1		return TRUE;
108			}
109
110	4		static void lazyinit_post_initslot(pTHX_ SlotMeta slotmeta, SV hookdata, void _funcdata, SV slot)
111			{
112	4		SV *weakself = newSVsv(PAD_SVl(PADIX_SELF));
113	4		sv_rvweaken(weakself);
114
115	4		sv_magicext(slot, weakself, PERL_MAGIC_ext, &vtbl, (char *)hookdata, HEf_SVKEY);
116
117			SvREFCNT_dec(weakself);
118	4		}
119
120			static const struct SlotHookFuncs lazyinit_hooks = {
121			.ver = OBJECTPAD_ABIVERSION,
122			.flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
123			.permit_hintkey = "Object::Pad::SlotAttr::LazyInit/LazyInit",
124			.apply = &lazyinit_apply,
125			.post_initslot = &lazyinit_post_initslot,
126			};
127
128			MODULE = Object::Pad::SlotAttr::LazyInit PACKAGE = Object::Pad::SlotAttr::LazyInit
129
130			BOOT:
131	2		register_slot_attribute("LazyInit", &lazyinit_hooks, NULL);
132
133	2		unassigned_val = newSV(0);