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

################################################################################
##
##  $Revision: 13 $
##  $Author: mhx $
##  $Date: 2007/08/12 23:24:34 +0200 $
##
################################################################################
##
##  Version 3.x, Copyright (C) 2004-2007, 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 {                                                 \
     if (name && namlen == 0)                                   \
     {                                                          \
       MAGIC *mg;                                               \
       sv_magic(sv, obj, how, 0, 0);                            \
       mg = SvMAGIC(sv);                                        \
       mg->mg_len = -42; /* XXX: this is the tricky part */     \
       mg->mg_ptr = name;                                       \
     }                                                          \
     else                                                       \
     {                                                          \
       sv_magic(sv, obj, how, name, 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, '~', 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	##
679ad62d	3	## $Revision: 13 $
adfe19db	4	## $Author: mhx $
679ad62d	5	## $Date: 2007/08/12 23:24:34 +0200 $
adfe19db	6	##
	7	################################################################################
	8	##
d2dacc4f	9	## Version 3.x, Copyright (C) 2004-2007, 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
	184	# define sv_magic_portable(sv, obj, how, name, namlen) \
	185	STMT_START { \
	186	if (name && namlen == 0) \
	187	{ \
	188	MAGIC *mg; \
	189	sv_magic(sv, obj, how, 0, 0); \
	190	mg = SvMAGIC(sv); \
	191	mg->mg_len = -42; /* XXX: this is the tricky part */ \
	192	mg->mg_ptr = name; \
	193	} \
	194	else \
	195	{ \
	196	sv_magic(sv, obj, how, name, namlen); \
	197	} \
	198	} STMT_END
	199
	200	#else
	201
	202	# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
	203
	204	#endif
	205
adfe19db	206	=xsubs
	207
	208	void
	209	sv_catpv_mg(sv, string)
	210	SV *sv;
	211	char *string;
	212	CODE:
	213	sv_catpv_mg(sv, string);
	214
	215	void
	216	sv_catpvn_mg(sv, sv2)
	217	SV *sv;
	218	SV *sv2;
	219	PREINIT:
	220	char *str;
	221	STRLEN len;
	222	CODE:
	223	str = SvPV(sv2, len);
	224	sv_catpvn_mg(sv, str, len);
	225
	226	void
	227	sv_catsv_mg(sv, sv2)
	228	SV *sv;
	229	SV *sv2;
	230	CODE:
	231	sv_catsv_mg(sv, sv2);
	232
	233	void
	234	sv_setiv_mg(sv, iv)
	235	SV *sv;
	236	IV iv;
	237	CODE:
	238	sv_setiv_mg(sv, iv);
	239
	240	void
	241	sv_setnv_mg(sv, nv)
	242	SV *sv;
	243	NV nv;
	244	CODE:
	245	sv_setnv_mg(sv, nv);
	246
	247	void
	248	sv_setpv_mg(sv, pv)
	249	SV *sv;
	250	char *pv;
	251	CODE:
	252	sv_setpv_mg(sv, pv);
	253
	254	void
	255	sv_setpvn_mg(sv, sv2)
	256	SV *sv;
	257	SV *sv2;
	258	PREINIT:
	259	char *str;
	260	STRLEN len;
	261	CODE:
	262	str = SvPV(sv2, len);
	263	sv_setpvn_mg(sv, str, len);
	264
	265	void
	266	sv_setsv_mg(sv, sv2)
	267	SV *sv;
	268	SV *sv2;
	269	CODE:
270	sv_setsv_mg(sv, sv2);
271
272	void
273	sv_setuv_mg(sv, uv)
274	SV *sv;
275	UV uv;
276	CODE:
277	sv_setuv_mg(sv, uv);
278
279	void
280	sv_usepvn_mg(sv, sv2)
281	SV *sv;
282	SV *sv2;
283	PREINIT:
284	char str, copy;
285	STRLEN len;
286	CODE:
287	str = SvPV(sv2, len);
288	New(42, copy, len+1, char);
289	Copy(str, copy, len+1, char);
290	sv_usepvn_mg(sv, copy, len);
291
f2ab5a41	292	int
	293	SvVSTRING_mg(sv)
	294	SV *sv;
	295	CODE:
	296	RETVAL = SvVSTRING_mg(sv) != NULL;
	297	OUTPUT:
	298	RETVAL
	299
679ad62d	300	int
	301	sv_magic_portable(sv)
	302	SV *sv
	303	PREINIT:
	304	MAGIC *mg;
	305	const char *foo = "foo";
	306	CODE:
	307	#if { VERSION >= 5.004 }
	308	sv_magic_portable(sv, 0, '~', foo, 0);
	309	mg = mg_find(sv, '~');
	310	RETVAL = mg->mg_ptr == foo;
	311	#else
	312	sv_magic(sv, 0, '~', foo, strlen(foo));
	313	mg = mg_find(sv, '~');
	314	RETVAL = strEQ(mg->mg_ptr, foo);
	315	#endif
	316	sv_unmagic(sv, '~');
	317	OUTPUT:
	318	RETVAL
	319
	320	=tests plan => 15
adfe19db	321
	322	use Tie::Hash;
	323	my %h;
	324	tie %h, 'Tie::StdHash';
	325	$h{foo} = 'foo';
	326	$h{bar} = '';
	327
	328	&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
	329	ok($h{foo}, 'foobar');
	330
	331	&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
	332	ok($h{bar}, 'baz');
	333
	334	&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
	335	ok($h{foo}, 'foobar42');
	336
	337	&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
	338	ok($h{bar}, 42);
	339
	340	&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
	341	ok(abs($h{PI} - 3.14159) < 0.01);
	342
	343	&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
	344	ok($h{mhx}, 'mhx');
	345
	346	&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
	347	ok($h{mhx}, 'Marcus');
	348
	349	&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
	350	ok($h{sv}, 'SV');
	351
	352	&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
	353	ok($h{sv}, 4711);
	354
	355	&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
	356	ok($h{sv}, 'Perl');
	357
f2ab5a41	358	my $ver = eval qq[qv("v1.2.0")];
	359	ok($[ < 5.009 \|\| $@ eq '');
	360	ok($@ \|\| Devel::PPPort::SvVSTRING_mg($ver));
	361	ok(!Devel::PPPort::SvVSTRING_mg(4711));
	362
679ad62d	363	my $foo = 'bar';
	364	ok(Devel::PPPort::sv_magic_portable($foo));
	365	ok($foo eq 'bar');
	366