[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / parts / inc / magic

################################################################################
##
##  $Revision: 16 $
##  $Author: mhx $
##  $Date: 2008/01/04 10:47:44 +0100 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2008, Marcus Holland-Moritz.
##  Version 2.x, Copyright (C) 2001, Paul Marquess.
##  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
##
##  This program is free software; you can redistribute it and/or
##  modify it under the same terms as Perl itself.
##
################################################################################

=provides

__UNDEFINED__
/sv_\w+_mg/
sv_magic_portable

=implementation

__UNDEFINED__  SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END

__UNDEFINED__  PERL_MAGIC_sv              '\0'
__UNDEFINED__  PERL_MAGIC_overload        'A'
__UNDEFINED__  PERL_MAGIC_overload_elem   'a'
__UNDEFINED__  PERL_MAGIC_overload_table  'c'
__UNDEFINED__  PERL_MAGIC_bm              'B'
__UNDEFINED__  PERL_MAGIC_regdata         'D'
__UNDEFINED__  PERL_MAGIC_regdatum        'd'
__UNDEFINED__  PERL_MAGIC_env             'E'
__UNDEFINED__  PERL_MAGIC_envelem         'e'
__UNDEFINED__  PERL_MAGIC_fm              'f'
__UNDEFINED__  PERL_MAGIC_regex_global    'g'
__UNDEFINED__  PERL_MAGIC_isa             'I'
__UNDEFINED__  PERL_MAGIC_isaelem         'i'
__UNDEFINED__  PERL_MAGIC_nkeys           'k'
__UNDEFINED__  PERL_MAGIC_dbfile          'L'
__UNDEFINED__  PERL_MAGIC_dbline          'l'
__UNDEFINED__  PERL_MAGIC_mutex           'm'
__UNDEFINED__  PERL_MAGIC_shared          'N'
__UNDEFINED__  PERL_MAGIC_shared_scalar   'n'
__UNDEFINED__  PERL_MAGIC_collxfrm        'o'
__UNDEFINED__  PERL_MAGIC_tied            'P'
__UNDEFINED__  PERL_MAGIC_tiedelem        'p'
__UNDEFINED__  PERL_MAGIC_tiedscalar      'q'
__UNDEFINED__  PERL_MAGIC_qr              'r'
__UNDEFINED__  PERL_MAGIC_sig             'S'
__UNDEFINED__  PERL_MAGIC_sigelem         's'
__UNDEFINED__  PERL_MAGIC_taint           't'
__UNDEFINED__  PERL_MAGIC_uvar            'U'
__UNDEFINED__  PERL_MAGIC_uvar_elem       'u'
__UNDEFINED__  PERL_MAGIC_vstring         'V'
__UNDEFINED__  PERL_MAGIC_vec             'v'
__UNDEFINED__  PERL_MAGIC_utf8            'w'
__UNDEFINED__  PERL_MAGIC_substr          'x'
__UNDEFINED__  PERL_MAGIC_defelem         'y'
__UNDEFINED__  PERL_MAGIC_glob            '*'
__UNDEFINED__  PERL_MAGIC_arylen          '#'
__UNDEFINED__  PERL_MAGIC_pos             '.'
__UNDEFINED__  PERL_MAGIC_backref         '<'
__UNDEFINED__  PERL_MAGIC_ext             '~'

/* That's the best we can do... */
__UNDEFINED__  sv_catpvn_nomg     sv_catpvn
__UNDEFINED__  sv_catsv_nomg      sv_catsv
__UNDEFINED__  sv_setsv_nomg      sv_setsv
__UNDEFINED__  sv_pvn_nomg        sv_pvn
__UNDEFINED__  SvIV_nomg          SvIV
__UNDEFINED__  SvUV_nomg          SvUV

#ifndef sv_catpv_mg
#  define sv_catpv_mg(sv, ptr)          \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_catpv(TeMpSv,ptr);              \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_catpvn_mg
#  define sv_catpvn_mg(sv, ptr, len)    \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_catpvn(TeMpSv,ptr,len);         \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_catsv_mg
#  define sv_catsv_mg(dsv, ssv)         \
   STMT_START {                         \
     SV *TeMpSv = dsv;                  \
     sv_catsv(TeMpSv,ssv);              \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_setiv_mg
#  define sv_setiv_mg(sv, i)            \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_setiv(TeMpSv,i);                \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_setnv_mg
#  define sv_setnv_mg(sv, num)          \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_setnv(TeMpSv,num);              \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_setpv_mg
#  define sv_setpv_mg(sv, ptr)          \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_setpv(TeMpSv,ptr);              \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_setpvn_mg
#  define sv_setpvn_mg(sv, ptr, len)    \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_setpvn(TeMpSv,ptr,len);         \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_setsv_mg
#  define sv_setsv_mg(dsv, ssv)         \
   STMT_START {                         \
     SV *TeMpSv = dsv;                  \
     sv_setsv(TeMpSv,ssv);              \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_setuv_mg
#  define sv_setuv_mg(sv, i)            \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_setuv(TeMpSv,i);                \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

#ifndef sv_usepvn_mg
#  define sv_usepvn_mg(sv, ptr, len)    \
   STMT_START {                         \
     SV *TeMpSv = sv;                   \
     sv_usepvn(TeMpSv,ptr,len);         \
     SvSETMAGIC(TeMpSv);                \
   } STMT_END
#endif

__UNDEFINED__  SvVSTRING_mg(sv)  (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)

/* Hint: sv_magic_portable
 * This is a compatibility function that is only available with
 * Devel::PPPort. It is NOT in the perl core.
 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
 * it is being passed a name pointer with namlen == 0. In that
 * case, perl 5.8.0 and later store the pointer, not a copy of it.
 * The compatibility can be provided back to perl 5.004. With
 * earlier versions, the code will not compile.
 */

#if { VERSION < 5.004 }

  /* code that uses sv_magic_portable will not compile */

#elif { VERSION < 5.8.0 }

#  define sv_magic_portable(sv, obj, how, name, namlen)     \
   STMT_START {                                             \
     SV *SvMp_sv = (sv);                                    \
     char *SvMp_name = (char *) (name);                     \
     I32 SvMp_namlen = (namlen);                            \
     if (SvMp_name && SvMp_namlen == 0)                     \
     {                                                      \
       MAGIC *mg;                                           \
       sv_magic(SvMp_sv, obj, how, 0, 0);                   \
       mg = SvMAGIC(SvMp_sv);                               \
       mg->mg_len = -42; /* XXX: this is the tricky part */ \
       mg->mg_ptr = SvMp_name;                              \
     }                                                      \
     else                                                   \
     {                                                      \
       sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
     }                                                      \
   } STMT_END

#else

#  define sv_magic_portable(a, b, c, d, e)  sv_magic(a, b, c, d, e)

#endif

=xsubs

void
sv_catpv_mg(sv, string)
	SV *sv;
	char *string;
	CODE:
		sv_catpv_mg(sv, string);

void
sv_catpvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		sv_catpvn_mg(sv, str, len);

void
sv_catsv_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	CODE:
		sv_catsv_mg(sv, sv2);

void
sv_setiv_mg(sv, iv)
	SV *sv;
	IV iv;
	CODE:
		sv_setiv_mg(sv, iv);

void
sv_setnv_mg(sv, nv)
	SV *sv;
	NV nv;
	CODE:
		sv_setnv_mg(sv, nv);

void
sv_setpv_mg(sv, pv)
	SV *sv;
	char *pv;
	CODE:
		sv_setpv_mg(sv, pv);

void
sv_setpvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		sv_setpvn_mg(sv, str, len);

void
sv_setsv_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	CODE:
		sv_setsv_mg(sv, sv2);

void
sv_setuv_mg(sv, uv)
	SV *sv;
	UV uv;
	CODE:
		sv_setuv_mg(sv, uv);

void
sv_usepvn_mg(sv, sv2)
	SV *sv;
	SV *sv2;
	PREINIT:
		char *str, *copy;
		STRLEN len;
	CODE:
		str = SvPV(sv2, len);
		New(42, copy, len+1, char);
		Copy(str, copy, len+1, char);
		sv_usepvn_mg(sv, copy, len);

int
SvVSTRING_mg(sv)
	SV *sv;
	CODE:
		RETVAL = SvVSTRING_mg(sv) != NULL;
	OUTPUT:
		RETVAL

int
sv_magic_portable(sv)
	SV *sv
	PREINIT:
		MAGIC *mg;
		const char *foo = "foo";
	CODE:
#if { VERSION >= 5.004 }
		sv_magic_portable(sv, 0, '~', foo, 0);
		mg = mg_find(sv, '~');
		RETVAL = mg->mg_ptr == foo;
#else
		sv_magic(sv, 0, '~', (char *) foo, strlen(foo));
		mg = mg_find(sv, '~');
		RETVAL = strEQ(mg->mg_ptr, foo);
#endif
		sv_unmagic(sv, '~');
	OUTPUT:
		RETVAL

=tests plan => 15

use Tie::Hash;
my %h;
tie %h, 'Tie::StdHash';
$h{foo} = 'foo';
$h{bar} = '';

&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
ok($h{foo}, 'foobar');

&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
ok($h{bar}, 'baz');

&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
ok($h{foo}, 'foobar42');

&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
ok($h{bar}, 42);

&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
ok(abs($h{PI} - 3.14159) < 0.01);

&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
ok($h{mhx}, 'mhx');

&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
ok($h{mhx}, 'Marcus');

&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
ok($h{sv}, 'SV');

&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
ok($h{sv}, 4711);

&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
ok($h{sv}, 'Perl');

my $ver = eval qq[qv("v1.2.0")];
ok($[ < 5.009 || $@ eq '');
ok($@ || Devel::PPPort::SvVSTRING_mg($ver));
ok(!Devel::PPPort::SvVSTRING_mg(4711));

my $foo = 'bar';
ok(Devel::PPPort::sv_magic_portable($foo));
ok($foo eq 'bar');
Commit	Line	Data
adfe19db	1	################################################################################
adfe19db	2	##
c1a049cb	3	## $Revision: 16 $
adfe19db	4	## $Author: mhx $
c1a049cb	5	## $Date: 2008/01/04 10:47:44 +0100 $
adfe19db	6	##
	7	################################################################################
	8	##
c1a049cb	9	## Version 3.x, Copyright (C) 2004-2008, Marcus Holland-Moritz.
adfe19db	10	## Version 2.x, Copyright (C) 2001, Paul Marquess.
	11	## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	12	##
	13	## This program is free software; you can redistribute it and/or
	14	## modify it under the same terms as Perl itself.
	15	##
	16	################################################################################
	17
	18	=provides
	19
	20	__UNDEFINED__
	21	/sv_\w+_mg/
679ad62d	22	sv_magic_portable
adfe19db	23
	24	=implementation
	25
	26	__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
	27
	28	__UNDEFINED__ PERL_MAGIC_sv '\0'
	29	__UNDEFINED__ PERL_MAGIC_overload 'A'
	30	__UNDEFINED__ PERL_MAGIC_overload_elem 'a'
	31	__UNDEFINED__ PERL_MAGIC_overload_table 'c'
	32	__UNDEFINED__ PERL_MAGIC_bm 'B'
	33	__UNDEFINED__ PERL_MAGIC_regdata 'D'
	34	__UNDEFINED__ PERL_MAGIC_regdatum 'd'
	35	__UNDEFINED__ PERL_MAGIC_env 'E'
	36	__UNDEFINED__ PERL_MAGIC_envelem 'e'
	37	__UNDEFINED__ PERL_MAGIC_fm 'f'
	38	__UNDEFINED__ PERL_MAGIC_regex_global 'g'
	39	__UNDEFINED__ PERL_MAGIC_isa 'I'
	40	__UNDEFINED__ PERL_MAGIC_isaelem 'i'
	41	__UNDEFINED__ PERL_MAGIC_nkeys 'k'
	42	__UNDEFINED__ PERL_MAGIC_dbfile 'L'
	43	__UNDEFINED__ PERL_MAGIC_dbline 'l'
	44	__UNDEFINED__ PERL_MAGIC_mutex 'm'
	45	__UNDEFINED__ PERL_MAGIC_shared 'N'
	46	__UNDEFINED__ PERL_MAGIC_shared_scalar 'n'
	47	__UNDEFINED__ PERL_MAGIC_collxfrm 'o'
	48	__UNDEFINED__ PERL_MAGIC_tied 'P'
	49	__UNDEFINED__ PERL_MAGIC_tiedelem 'p'
	50	__UNDEFINED__ PERL_MAGIC_tiedscalar 'q'
	51	__UNDEFINED__ PERL_MAGIC_qr 'r'
	52	__UNDEFINED__ PERL_MAGIC_sig 'S'
	53	__UNDEFINED__ PERL_MAGIC_sigelem 's'
	54	__UNDEFINED__ PERL_MAGIC_taint 't'
	55	__UNDEFINED__ PERL_MAGIC_uvar 'U'
	56	__UNDEFINED__ PERL_MAGIC_uvar_elem 'u'
	57	__UNDEFINED__ PERL_MAGIC_vstring 'V'
	58	__UNDEFINED__ PERL_MAGIC_vec 'v'
	59	__UNDEFINED__ PERL_MAGIC_utf8 'w'
	60	__UNDEFINED__ PERL_MAGIC_substr 'x'
	61	__UNDEFINED__ PERL_MAGIC_defelem 'y'
	62	__UNDEFINED__ PERL_MAGIC_glob '*'
	63	__UNDEFINED__ PERL_MAGIC_arylen '#'
	64	__UNDEFINED__ PERL_MAGIC_pos '.'
	65	__UNDEFINED__ PERL_MAGIC_backref '<'
	66	__UNDEFINED__ PERL_MAGIC_ext '~'
	67
	68	/* That's the best we can do... */
adfe19db	69	__UNDEFINED__ sv_catpvn_nomg sv_catpvn
	70	__UNDEFINED__ sv_catsv_nomg sv_catsv
	71	__UNDEFINED__ sv_setsv_nomg sv_setsv
	72	__UNDEFINED__ sv_pvn_nomg sv_pvn
	73	__UNDEFINED__ SvIV_nomg SvIV
	74	__UNDEFINED__ SvUV_nomg SvUV
	75
	76	#ifndef sv_catpv_mg
	77	# define sv_catpv_mg(sv, ptr) \
	78	STMT_START { \
	79	SV *TeMpSv = sv; \
	80	sv_catpv(TeMpSv,ptr); \
	81	SvSETMAGIC(TeMpSv); \
	82	} STMT_END
	83	#endif
	84
	85	#ifndef sv_catpvn_mg
	86	# define sv_catpvn_mg(sv, ptr, len) \
	87	STMT_START { \
	88	SV *TeMpSv = sv; \
	89	sv_catpvn(TeMpSv,ptr,len); \
	90	SvSETMAGIC(TeMpSv); \
	91	} STMT_END
	92	#endif
	93
	94	#ifndef sv_catsv_mg
	95	# define sv_catsv_mg(dsv, ssv) \
	96	STMT_START { \
	97	SV *TeMpSv = dsv; \
	98	sv_catsv(TeMpSv,ssv); \
	99	SvSETMAGIC(TeMpSv); \
	100	} STMT_END
	101	#endif
	102
	103	#ifndef sv_setiv_mg
	104	# define sv_setiv_mg(sv, i) \
	105	STMT_START { \
	106	SV *TeMpSv = sv; \
	107	sv_setiv(TeMpSv,i); \
	108	SvSETMAGIC(TeMpSv); \
	109	} STMT_END
	110	#endif
	111
	112	#ifndef sv_setnv_mg
	113	# define sv_setnv_mg(sv, num) \
	114	STMT_START { \
	115	SV *TeMpSv = sv; \
	116	sv_setnv(TeMpSv,num); \
	117	SvSETMAGIC(TeMpSv); \
	118	} STMT_END
	119	#endif
	120
	121	#ifndef sv_setpv_mg
	122	# define sv_setpv_mg(sv, ptr) \
	123	STMT_START { \
	124	SV *TeMpSv = sv; \
	125	sv_setpv(TeMpSv,ptr); \
	126	SvSETMAGIC(TeMpSv); \
	127	} STMT_END
	128	#endif
	129
	130	#ifndef sv_setpvn_mg
	131	# define sv_setpvn_mg(sv, ptr, len) \
	132	STMT_START { \
133	SV *TeMpSv = sv; \
134	sv_setpvn(TeMpSv,ptr,len); \
135	SvSETMAGIC(TeMpSv); \
136	} STMT_END
137	#endif
138
139	#ifndef sv_setsv_mg
140	# define sv_setsv_mg(dsv, ssv) \
141	STMT_START { \
142	SV *TeMpSv = dsv; \
143	sv_setsv(TeMpSv,ssv); \
144	SvSETMAGIC(TeMpSv); \
145	} STMT_END
146	#endif
147
148	#ifndef sv_setuv_mg
149	# define sv_setuv_mg(sv, i) \
150	STMT_START { \
151	SV *TeMpSv = sv; \
152	sv_setuv(TeMpSv,i); \
153	SvSETMAGIC(TeMpSv); \
154	} STMT_END
155	#endif
156
157	#ifndef sv_usepvn_mg
158	# define sv_usepvn_mg(sv, ptr, len) \
159	STMT_START { \
160	SV *TeMpSv = sv; \
161	sv_usepvn(TeMpSv,ptr,len); \
162	SvSETMAGIC(TeMpSv); \
163	} STMT_END
164	#endif
165
f2ab5a41	166	__UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
f2ab5a41	167
679ad62d	168	/* Hint: sv_magic_portable
	169	* This is a compatibility function that is only available with
	170	* Devel::PPPort. It is NOT in the perl core.
	171	* Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
	172	* it is being passed a name pointer with namlen == 0. In that
	173	* case, perl 5.8.0 and later store the pointer, not a copy of it.
	174	* The compatibility can be provided back to perl 5.004. With
	175	* earlier versions, the code will not compile.
	176	*/
	177
	178	#if { VERSION < 5.004 }
	179
	180	/* code that uses sv_magic_portable will not compile */
	181
	182	#elif { VERSION < 5.8.0 }
	183
c83e6f19	184	# define sv_magic_portable(sv, obj, how, name, namlen) \
	185	STMT_START { \
	186	SV *SvMp_sv = (sv); \
	187	char SvMp_name = (char ) (name); \
	188	I32 SvMp_namlen = (namlen); \
	189	if (SvMp_name && SvMp_namlen == 0) \
	190	{ \
	191	MAGIC *mg; \
	192	sv_magic(SvMp_sv, obj, how, 0, 0); \
	193	mg = SvMAGIC(SvMp_sv); \
	194	mg->mg_len = -42; /* XXX: this is the tricky part */ \
	195	mg->mg_ptr = SvMp_name; \
	196	} \
	197	else \
	198	{ \
	199	sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
	200	} \
679ad62d	201	} STMT_END
	202
	203	#else
	204
	205	# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
	206
	207	#endif
	208
adfe19db	209	=xsubs
	210
	211	void
	212	sv_catpv_mg(sv, string)
	213	SV *sv;
	214	char *string;
	215	CODE:
	216	sv_catpv_mg(sv, string);
	217
	218	void
	219	sv_catpvn_mg(sv, sv2)
	220	SV *sv;
	221	SV *sv2;
	222	PREINIT:
	223	char *str;
	224	STRLEN len;
	225	CODE:
	226	str = SvPV(sv2, len);
	227	sv_catpvn_mg(sv, str, len);
	228
	229	void
	230	sv_catsv_mg(sv, sv2)
	231	SV *sv;
	232	SV *sv2;
	233	CODE:
	234	sv_catsv_mg(sv, sv2);
	235
	236	void
	237	sv_setiv_mg(sv, iv)
	238	SV *sv;
	239	IV iv;
	240	CODE:
	241	sv_setiv_mg(sv, iv);
	242
	243	void
	244	sv_setnv_mg(sv, nv)
	245	SV *sv;
	246	NV nv;
	247	CODE:
	248	sv_setnv_mg(sv, nv);
	249
	250	void
	251	sv_setpv_mg(sv, pv)
	252	SV *sv;
	253	char *pv;
	254	CODE:
	255	sv_setpv_mg(sv, pv);
	256
	257	void
	258	sv_setpvn_mg(sv, sv2)
	259	SV *sv;
	260	SV *sv2;
	261	PREINIT:
	262	char *str;
	263	STRLEN len;
	264	CODE:
	265	str = SvPV(sv2, len);
	266	sv_setpvn_mg(sv, str, len);
	267
	268	void
	269	sv_setsv_mg(sv, sv2)
	270	SV *sv;
	271	SV *sv2;
	272	CODE:
273	sv_setsv_mg(sv, sv2);
274
275	void
276	sv_setuv_mg(sv, uv)
277	SV *sv;
278	UV uv;
279	CODE:
280	sv_setuv_mg(sv, uv);
281
282	void
283	sv_usepvn_mg(sv, sv2)
284	SV *sv;
285	SV *sv2;
286	PREINIT:
287	char str, copy;
288	STRLEN len;
289	CODE:
290	str = SvPV(sv2, len);
291	New(42, copy, len+1, char);
292	Copy(str, copy, len+1, char);
293	sv_usepvn_mg(sv, copy, len);
294
f2ab5a41	295	int
	296	SvVSTRING_mg(sv)
	297	SV *sv;
	298	CODE:
	299	RETVAL = SvVSTRING_mg(sv) != NULL;
	300	OUTPUT:
	301	RETVAL
	302
679ad62d	303	int
	304	sv_magic_portable(sv)
	305	SV *sv
	306	PREINIT:
	307	MAGIC *mg;
	308	const char *foo = "foo";
	309	CODE:
	310	#if { VERSION >= 5.004 }
	311	sv_magic_portable(sv, 0, '~', foo, 0);
	312	mg = mg_find(sv, '~');
	313	RETVAL = mg->mg_ptr == foo;
	314	#else
aab9a3b6	315	sv_magic(sv, 0, '~', (char *) foo, strlen(foo));
679ad62d	316	mg = mg_find(sv, '~');
	317	RETVAL = strEQ(mg->mg_ptr, foo);
	318	#endif
	319	sv_unmagic(sv, '~');
	320	OUTPUT:
	321	RETVAL
	322
	323	=tests plan => 15
adfe19db	324
	325	use Tie::Hash;
	326	my %h;
	327	tie %h, 'Tie::StdHash';
	328	$h{foo} = 'foo';
	329	$h{bar} = '';
	330
	331	&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
	332	ok($h{foo}, 'foobar');
	333
	334	&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
	335	ok($h{bar}, 'baz');
	336
	337	&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
	338	ok($h{foo}, 'foobar42');
	339
	340	&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
	341	ok($h{bar}, 42);
	342
	343	&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
	344	ok(abs($h{PI} - 3.14159) < 0.01);
	345
	346	&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
	347	ok($h{mhx}, 'mhx');
	348
	349	&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
	350	ok($h{mhx}, 'Marcus');
	351
	352	&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
	353	ok($h{sv}, 'SV');
	354
	355	&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
	356	ok($h{sv}, 4711);
	357
	358	&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
	359	ok($h{sv}, 'Perl');
	360
f2ab5a41	361	my $ver = eval qq[qv("v1.2.0")];
	362	ok($[ < 5.009 \|\| $@ eq '');
	363	ok($@ \|\| Devel::PPPort::SvVSTRING_mg($ver));
	364	ok(!Devel::PPPort::SvVSTRING_mg(4711));
	365
679ad62d	366	my $foo = 'bar';
	367	ok(Devel::PPPort::sv_magic_portable($foo));
	368	ok($foo eq 'bar');
	369