view release on metacpan or  search on metacpan

ext/XS-APItest/APItest.xs  view on Meta::CPAN

    PPCODE:
        if (!SvOK(sv) || !SvROK(sv)) { XSRETURN_UNDEF; }
        sv = SvRV(sv);
        EXTEND(SP, 3);
        mXPUSHu(SvFLAGS(sv) & SVs_GMG);
        mXPUSHu(SvFLAGS(sv) & SVs_SMG);
        mXPUSHu(SvFLAGS(sv) & SVs_RMG);
        XSRETURN(3);

void
my_caller(level)
        I32 level
    PREINIT:
        const PERL_CONTEXT *cx, *dbcx;
        const char *pv;
        const GV *gv;
        HV *hv;
    PPCODE:
        cx = caller_cx(level, &dbcx);
        EXTEND(SP, 8);

        pv = CopSTASHPV(cx->blk_oldcop);
        ST(0) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
        gv = CvGV(cx->blk_sub.cv);
        ST(1) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;

        pv = CopSTASHPV(dbcx->blk_oldcop);
        ST(2) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef;
        gv = CvGV(dbcx->blk_sub.cv);
        ST(3) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef;

        ST(4) = cop_hints_fetch_pvs(cx->blk_oldcop, "foo", 0);
        ST(5) = cop_hints_fetch_pvn(cx->blk_oldcop, "foo", 3, 0, 0);
        ST(6) = cop_hints_fetch_sv(cx->blk_oldcop,
                sv_2mortal(newSVpvs("foo")), 0, 0);

        hv = cop_hints_2hv(cx->blk_oldcop, 0);
        ST(7) = hv ? sv_2mortal(newRV_noinc((SV *)hv)) : &PL_sv_undef;

        XSRETURN(8);

void
DPeek (sv)
    SV   *sv

  PPCODE:
    ST (0) = newSVpv (Perl_sv_peek (aTHX_ sv), 0);
    XSRETURN (1);

void
BEGIN()
    CODE:
        sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));

void
CHECK()
    CODE:
        sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));

void
UNITCHECK()
    CODE:
        sv_inc(get_sv("XS::APItest::UNITCHECK_called", GV_ADD|GV_ADDMULTI));

void
INIT()
    CODE:
        sv_inc(get_sv("XS::APItest::INIT_called", GV_ADD|GV_ADDMULTI));

void
END()
    CODE:
        sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));

void
utf16_to_utf8 (sv, ...)
    SV* sv
        ALIAS:
            utf16_to_utf8_reversed = 1
    PREINIT:
        STRLEN len;
        U8 *source;
        SV *dest;
        Size_t got;
    CODE:
        source = (U8 *)SvPVbyte(sv, len);
        /* Optionally only convert part of the buffer.  */
        if (items > 1) {
            len = SvUV(ST(1));
        }
        /* Mortalise this right now, as we'll be testing croak()s  */
        dest = sv_2mortal(newSV(len * 2 + 1));
        if (ix) {
            utf16_to_utf8_reversed(source, (U8 *)SvPVX(dest), len, &got);
        } else {
            utf16_to_utf8(source, (U8 *)SvPVX(dest), len, &got);
        }
        SvCUR_set(dest, got);
        SvPVX(dest)[got] = '\0';
        SvPOK_on(dest);
        ST(0) = dest;
        XSRETURN(1);

void
utf8_to_utf16 (sv, ...)
    SV* sv
        ALIAS:
            utf8_to_utf16_reversed = 1
    PREINIT:
        STRLEN len;
        U8 *source;
        SV *dest;
        Size_t got;
    CODE:
        source = (U8 *)SvPV(sv, len);
        /* Optionally only convert part of the buffer.  */
        if (items > 1) {
            len = SvUV(ST(1));
        }
        /* Mortalise this right now, as we'll be testing croak()s  */
        dest = sv_2mortal(newSV(len * 2 + 1));
        if (ix) {
            utf8_to_utf16_reversed(source, (U8 *)SvPVX(dest), len, &got);