Eshu

 view release on metacpan or  search on metacpan

include/eshu_xs.h  view on Meta::CPAN

static int eshu_xs_is_module_line(const char *content, const char *eol) {
	const char *p = content;
	if (eol - p < 8) return 0;
	if (memcmp(p, "MODULE", 6) != 0) return 0;
	p += 6;
	while (p < eol && (*p == ' ' || *p == '\t')) p++;
	return (p < eol && *p == '=');
}

/* XS labels: CODE, INIT, OUTPUT, PREINIT, CLEANUP, POSTCALL,
 * PPCODE, BOOT, CASE, INTERFACE, INTERFACE_MACRO, PROTOTYPES,
 * VERSIONCHECK, INCLUDE, FALLBACK, OVERLOAD, ALIAS, ATTRS */
static int eshu_xs_is_label(const char *content, const char *eol,
                            int *is_boot) {
	const char *p = content;
	const char *start;
	int len;

	*is_boot = 0;

	/* must start with alpha */

include/eshu_xs.h  view on Meta::CPAN

	/* it also must not be a :: (package separator) */
	if (p + 1 < eol && *(p + 1) == ':') return 0;

	/* Known XS labels */
	if ((len == 4 && memcmp(start, "CODE", 4) == 0) ||
	    (len == 4 && memcmp(start, "INIT", 4) == 0) ||
	    (len == 6 && memcmp(start, "OUTPUT", 6) == 0) ||
	    (len == 7 && memcmp(start, "PREINIT", 7) == 0) ||
	    (len == 7 && memcmp(start, "CLEANUP", 7) == 0) ||
	    (len == 8 && memcmp(start, "POSTCALL", 8) == 0) ||
	    (len == 6 && memcmp(start, "PPCODE", 6) == 0) ||
	    (len == 4 && memcmp(start, "CASE", 4) == 0) ||
	    (len == 9 && memcmp(start, "INTERFACE", 9) == 0) ||
	    (len == 15 && memcmp(start, "INTERFACE_MACRO", 15) == 0) ||
	    (len == 10 && memcmp(start, "PROTOTYPES", 10) == 0) ||
	    (len == 12 && memcmp(start, "VERSIONCHECK", 12) == 0) ||
	    (len == 7 && memcmp(start, "INCLUDE", 7) == 0) ||
	    (len == 8 && memcmp(start, "FALLBACK", 8) == 0) ||
	    (len == 8 && memcmp(start, "OVERLOAD", 8) == 0) ||
	    (len == 5 && memcmp(start, "ALIAS", 5) == 0) ||
	    (len == 5 && memcmp(start, "ATTRS", 5) == 0)) {

t/0022-xs-labels.t  view on Meta::CPAN

	OUTPUT:
		RETVAL
	CLEANUP:
		free(val);
END

	my $got = Eshu->indent_xs($input);
	is($got, $expected, 'CLEANUP label at depth 1');
}

# PPCODE label
{
	my $input = <<'END';
MODULE = Foo  PACKAGE = Foo

void
get_pair()
PPCODE:
XPUSHs(sv_2mortal(newSViv(1)));
XPUSHs(sv_2mortal(newSViv(2)));
XSRETURN(2);
END

	my $expected = <<'END';
MODULE = Foo  PACKAGE = Foo

void
get_pair()
	PPCODE:
		XPUSHs(sv_2mortal(newSViv(1)));
		XPUSHs(sv_2mortal(newSViv(2)));
		XSRETURN(2);
END

	my $got = Eshu->indent_xs($input);
	is($got, $expected, 'PPCODE label at depth 1');
}

# INIT label (inside XSUB, not the Perl INIT{} block)
{
	my $input = <<'END';
MODULE = Foo  PACKAGE = Foo

int
sum(a, b)
int a

t/0026-xs-advanced.t  view on Meta::CPAN

		}
		RETVAL = count;
	OUTPUT:
		RETVAL
END

	my $got = Eshu->indent_xs($input);
	is($got, $expected, 'XSUB with nested C control flow in CODE');
}

# XSUB with PPCODE (list context)
{
	my $input = <<'END';
MODULE = Foo  PACKAGE = Foo

void
get_pair(self)
SV * self
PPCODE:
XPUSHs(sv_2mortal(newSVpvs("key")));
XPUSHs(sv_2mortal(newSViv(42)));
END

	my $expected = <<'END';
MODULE = Foo  PACKAGE = Foo

void
get_pair(self)
	SV * self
	PPCODE:
		XPUSHs(sv_2mortal(newSVpvs("key")));
		XPUSHs(sv_2mortal(newSViv(42)));
END

	my $got = Eshu->indent_xs($input);
	is($got, $expected, 'XSUB with PPCODE for list context');
}

done_testing();

t/0242-realworld-xs.t  view on Meta::CPAN

		size_t n = fread(buf, 1, len, fh);
		buf[n] = '\0';
		RETVAL = newSVpvn(buf, n);
		free(buf);
	OUTPUT:
		RETVAL
END
	is(xs($code), $code, 'XS: XSUB with INIT guard');
}

# 6. PPCODE XSUB returning list
{
	my $code = <<'END';
MODULE = ListOps    PACKAGE = ListOps

void
range(from, to)
	int from
	int to
	PPCODE:
		for (int i = from; i <= to; i++) {
			XPUSHs(sv_2mortal(newSViv(i)));
		}
END
	is(xs($code), $code, 'XS: PPCODE returning list');
}

# 7. XSUB with C helper function
{
	my $code = <<'END';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

static unsigned long

t/0242-realworld-xs.t  view on Meta::CPAN

}

# 13. XSUB with SV mortal
{
	my $code = <<'END';
MODULE = Fmt    PACKAGE = Fmt

void
print_pairs(href)
	SV *href
	PPCODE:
		HV *hv = (HV *)SvRV(href);
		HE *he;
		hv_iterinit(hv);
		while ((he = hv_iternext(hv)) != NULL) {
			SV *key = hv_iterkeysv(he);
			SV *val = hv_iterval(hv, he);
			XPUSHs(sv_2mortal(newSVpvf("%s=%s",
			SvPVutf8_nolen(key), SvPVutf8_nolen(val))));
		}
END
	is(xs($code), $code, 'XS: PPCODE iterating hash ref');
}

# 14. XSUB with typemap
{
	my $code = <<'END';
MODULE = File    PACKAGE = File

FILE *
fopen_wrap(path, mode)
	const char *path

t/0242-realworld-xs.t  view on Meta::CPAN

			SV **svp = av_fetch(in, i, 0);
			av_push(out, svp ? SvREFCNT_inc(*svp) : newSV(0));
		}
		RETVAL = newRV_noinc((SV *)out);
	OUTPUT:
		RETVAL
END
	is(xs($code), $code, 'XS: reverse array ref');
}

# 24. XSUB with multiple return values via PPCODE
{
	my $code = <<'END';
MODULE = Math2    PACKAGE = Math2

void
divmod(a, b)
	IV a
	IV b
	PPCODE:
		if (b == 0)
		Perl_croak(aTHX_ "division by zero");
		EXTEND(SP, 2);
		PUSHs(sv_2mortal(newSViv(a / b)));
		PUSHs(sv_2mortal(newSViv(a % b)));
END
	is(xs($code), $code, 'XS: divmod via PPCODE');
}

# 25. XS constant sub
{
	my $code = <<'END';
MODULE = Const    PACKAGE = Const

IV
PI_TIMES_1000()
	CODE:

t/0242-realworld-xs.t  view on Meta::CPAN

# 30
{
	my $in = <<'END';
MODULE = T    PACKAGE = T

void
each(aref, cb)
SV *aref
SV *cb
PPCODE:
AV *av = (AV *)SvRV(aref);
for (SSize_t i = 0; i <= av_len(av); i++) {
SV **svp = av_fetch(av, i, 0);
dSP; ENTER; SAVETMPS; PUSHMARK(SP);
XPUSHs(svp ? *svp : &PL_sv_undef);
PUTBACK; call_sv(cb, G_VOID|G_DISCARD);
FREETMPS; LEAVE;
}
END
	my $exp = <<'END';
MODULE = T    PACKAGE = T

void
each(aref, cb)
	SV *aref
	SV *cb
	PPCODE:
		AV *av = (AV *)SvRV(aref);
		for (SSize_t i = 0; i <= av_len(av); i++) {
			SV **svp = av_fetch(av, i, 0);
			dSP; ENTER; SAVETMPS; PUSHMARK(SP);
			XPUSHs(svp ? *svp : &PL_sv_undef);
			PUTBACK; call_sv(cb, G_VOID|G_DISCARD);
			FREETMPS; LEAVE;
		}
END
	is(xs($in), $exp, 'XS: unindented PPCODE with loop normalised');
}

# ── idempotency tests ──────────────────────────────────────────────

for my $snippet (
	"MODULE = T    PACKAGE = T\n\nint\nadd(a,b)\nint a\nint b\nCODE:\nRETVAL=a+b;\nOUTPUT:\nRETVAL\n",
	"MODULE = T    PACKAGE = T\n\nvoid\nnoop()\nCODE:\n/* nothing */\n",
	"#include \"EXTERN.h\"\n#include \"perl.h\"\n#include \"XSUB.h\"\nMODULE=T PACKAGE=T\nBOOT:\nSV*v=get_sv(\"T::VERSION\",GV_ADD);sv_setpvs(v,\"1.0\");\n",
	"MODULE=T PACKAGE=T\nSV*\nhex_sv(n)\nUV n\nCODE:\nchar b[32];snprintf(b,sizeof(b),\"0x%llx\",(ull)n);RETVAL=newSVpv(b,0);\nOUTPUT:\nRETVAL\n",
	"MODULE=T PACKAGE=T\nvoid\nfree_ptr(p)\nSV*p\nCODE:\nfree((void*)SvIV(p));\n",