|
Packit |
7d6a7d |
################################################################################
|
|
Packit |
7d6a7d |
##
|
|
Packit |
7d6a7d |
## Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
|
|
Packit |
7d6a7d |
## Version 2.x, Copyright (C) 2001, Paul Marquess.
|
|
Packit |
7d6a7d |
## Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
|
|
Packit |
7d6a7d |
##
|
|
Packit |
7d6a7d |
## This program is free software; you can redistribute it and/or
|
|
Packit |
7d6a7d |
## modify it under the same terms as Perl itself.
|
|
Packit |
7d6a7d |
##
|
|
Packit |
7d6a7d |
################################################################################
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=provides
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
vnewSVpvf
|
|
Packit |
7d6a7d |
sv_vcatpvf
|
|
Packit |
7d6a7d |
sv_vsetpvf
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
sv_catpvf_mg
|
|
Packit |
7d6a7d |
sv_catpvf_mg_nocontext
|
|
Packit |
7d6a7d |
sv_vcatpvf_mg
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
sv_setpvf_mg
|
|
Packit |
7d6a7d |
sv_setpvf_mg_nocontext
|
|
Packit |
7d6a7d |
sv_vsetpvf_mg
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=implementation
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(vnewSVpvf)
|
|
Packit |
7d6a7d |
#if { NEED vnewSVpvf }
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
SV *
|
|
Packit |
7d6a7d |
vnewSVpvf(pTHX_ const char *pat, va_list *args)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
register SV *sv = newSV(0);
|
|
Packit |
7d6a7d |
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
|
|
Packit |
7d6a7d |
return sv;
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_vcatpvf)
|
|
Packit |
7d6a7d |
# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_vsetpvf)
|
|
Packit |
7d6a7d |
# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg)
|
|
Packit |
7d6a7d |
#if { NEED sv_catpvf_mg }
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
va_list args;
|
|
Packit |
7d6a7d |
va_start(args, pat);
|
|
Packit |
7d6a7d |
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
|
|
Packit |
7d6a7d |
SvSETMAGIC(sv);
|
|
Packit |
7d6a7d |
va_end(args);
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#ifdef PERL_IMPLICIT_CONTEXT
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext)
|
|
Packit |
7d6a7d |
#if { NEED sv_catpvf_mg_nocontext }
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
dTHX;
|
|
Packit |
7d6a7d |
va_list args;
|
|
Packit |
7d6a7d |
va_start(args, pat);
|
|
Packit |
7d6a7d |
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
|
|
Packit |
7d6a7d |
SvSETMAGIC(sv);
|
|
Packit |
7d6a7d |
va_end(args);
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
|
|
Packit |
7d6a7d |
#ifndef sv_catpvf_mg
|
|
Packit |
7d6a7d |
# ifdef PERL_IMPLICIT_CONTEXT
|
|
Packit |
7d6a7d |
# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
|
|
Packit |
7d6a7d |
# else
|
|
Packit |
7d6a7d |
# define sv_catpvf_mg Perl_sv_catpvf_mg
|
|
Packit |
7d6a7d |
# endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg)
|
|
Packit |
7d6a7d |
# define sv_vcatpvf_mg(sv, pat, args) \
|
|
Packit |
7d6a7d |
STMT_START { \
|
|
Packit |
7d6a7d |
sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
|
|
Packit |
7d6a7d |
SvSETMAGIC(sv); \
|
|
Packit |
7d6a7d |
} STMT_END
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg)
|
|
Packit |
7d6a7d |
#if { NEED sv_setpvf_mg }
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
va_list args;
|
|
Packit |
7d6a7d |
va_start(args, pat);
|
|
Packit |
7d6a7d |
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
|
|
Packit |
7d6a7d |
SvSETMAGIC(sv);
|
|
Packit |
7d6a7d |
va_end(args);
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#ifdef PERL_IMPLICIT_CONTEXT
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext)
|
|
Packit |
7d6a7d |
#if { NEED sv_setpvf_mg_nocontext }
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
dTHX;
|
|
Packit |
7d6a7d |
va_list args;
|
|
Packit |
7d6a7d |
va_start(args, pat);
|
|
Packit |
7d6a7d |
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
|
|
Packit |
7d6a7d |
SvSETMAGIC(sv);
|
|
Packit |
7d6a7d |
va_end(args);
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
|
|
Packit |
7d6a7d |
#ifndef sv_setpvf_mg
|
|
Packit |
7d6a7d |
# ifdef PERL_IMPLICIT_CONTEXT
|
|
Packit |
7d6a7d |
# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
|
|
Packit |
7d6a7d |
# else
|
|
Packit |
7d6a7d |
# define sv_setpvf_mg Perl_sv_setpvf_mg
|
|
Packit |
7d6a7d |
# endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg)
|
|
Packit |
7d6a7d |
# define sv_vsetpvf_mg(sv, pat, args) \
|
|
Packit |
7d6a7d |
STMT_START { \
|
|
Packit |
7d6a7d |
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
|
|
Packit |
7d6a7d |
SvSETMAGIC(sv); \
|
|
Packit |
7d6a7d |
} STMT_END
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=xsinit
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
#define NEED_vnewSVpvf
|
|
Packit |
7d6a7d |
#define NEED_sv_catpvf_mg
|
|
Packit |
7d6a7d |
#define NEED_sv_catpvf_mg_nocontext
|
|
Packit |
7d6a7d |
#define NEED_sv_setpvf_mg
|
|
Packit |
7d6a7d |
#define NEED_sv_setpvf_mg_nocontext
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=xsmisc
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
SV *sv;
|
|
Packit |
7d6a7d |
va_list args;
|
|
Packit |
7d6a7d |
va_start(args, pat);
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
sv = vnewSVpvf(pat, &args);
|
|
Packit |
7d6a7d |
#else
|
|
Packit |
7d6a7d |
sv = newSVpv((char *) pat, 0);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
va_end(args);
|
|
Packit |
7d6a7d |
return sv;
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
va_list args;
|
|
Packit |
7d6a7d |
va_start(args, pat);
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
sv_vcatpvf(sv, pat, &args);
|
|
Packit |
7d6a7d |
#else
|
|
Packit |
7d6a7d |
sv_catpv(sv, (char *) pat);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
va_end(args);
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
|
|
Packit |
7d6a7d |
{
|
|
Packit |
7d6a7d |
va_list args;
|
|
Packit |
7d6a7d |
va_start(args, pat);
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
sv_vsetpvf(sv, pat, &args);
|
|
Packit |
7d6a7d |
#else
|
|
Packit |
7d6a7d |
sv_setpv(sv, (char *) pat);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
va_end(args);
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=xsubs
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
SV *
|
|
Packit |
7d6a7d |
vnewSVpvf()
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
|
|
Packit |
7d6a7d |
OUTPUT:
|
|
Packit |
7d6a7d |
RETVAL
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
SV *
|
|
Packit |
7d6a7d |
sv_vcatpvf(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
RETVAL = newSVsv(sv);
|
|
Packit |
7d6a7d |
test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
|
|
Packit |
7d6a7d |
OUTPUT:
|
|
Packit |
7d6a7d |
RETVAL
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
SV *
|
|
Packit |
7d6a7d |
sv_vsetpvf(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
RETVAL = newSVsv(sv);
|
|
Packit |
7d6a7d |
test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
|
|
Packit |
7d6a7d |
OUTPUT:
|
|
Packit |
7d6a7d |
RETVAL
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_catpvf_mg(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
Perl_sv_catpvf_mg(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_catpvf_mg_nocontext(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
#ifdef PERL_IMPLICIT_CONTEXT
|
|
Packit |
7d6a7d |
sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
|
|
Packit |
7d6a7d |
#else
|
|
Packit |
7d6a7d |
sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_setpvf_mg(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
Perl_sv_setpvf_mg(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
void
|
|
Packit |
7d6a7d |
sv_setpvf_mg_nocontext(sv)
|
|
Packit |
7d6a7d |
SV *sv
|
|
Packit |
7d6a7d |
CODE:
|
|
Packit |
7d6a7d |
#if { VERSION >= 5.004 }
|
|
Packit |
7d6a7d |
#ifdef PERL_IMPLICIT_CONTEXT
|
|
Packit |
7d6a7d |
sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
|
|
Packit |
7d6a7d |
#else
|
|
Packit |
7d6a7d |
sv_setpvf_mg(sv, "%s-%d", "bar", 44);
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
#endif
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=tests plan => 9
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
use Tie::Hash;
|
|
Packit |
7d6a7d |
my %h;
|
|
Packit |
7d6a7d |
tie %h, 'Tie::StdHash';
|
|
Packit |
7d6a7d |
$h{foo} = 'foo-';
|
|
Packit |
7d6a7d |
$h{bar} = '';
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d');
|
|
Packit |
7d6a7d |
ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
|
|
Packit |
7d6a7d |
ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d');
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
&Devel::PPPort::sv_catpvf_mg($h{foo});
|
|
Packit |
7d6a7d |
ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-');
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
|
|
Packit |
7d6a7d |
ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
|
|
Packit |
7d6a7d |
ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
&Devel::PPPort::sv_setpvf_mg($h{bar});
|
|
Packit |
7d6a7d |
ok($h{bar}, $] >= 5.004 ? 'mhx-42' : '');
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
|
|
Packit |
7d6a7d |
ok($h{bar}, $] >= 5.004 ? 'foo-43' : '');
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
|
|
Packit |
7d6a7d |
ok($h{bar}, $] >= 5.004 ? 'bar-44' : '');
|