The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

croak_sv die_sv mess_sv warn_sv

vmess mess_nocontext mess

warn_nocontext

croak_nocontext

croak_no_modify Perl_croak_no_modify

croak_memory_wrap croak_xs_usage

PERL_ARGS_ASSERT_CROAK_XS_USAGE

NEED_mess NEED_mess_nocontext NEED_vmess

#ifdef NEED_mess_sv #define NEED_mess #endif

#ifdef NEED_mess #define NEED_mess_nocontext #define NEED_vmess #endif

#ifndef croak_sv #if { VERSION >= 5.7.3 } || ( { VERSION >= 5.6.1 } && { VERSION < 5.7.0 } ) # if ( { VERSION >= 5.8.0 } && { VERSION < 5.8.9 } ) || ( { VERSION >= 5.9.0 } && { VERSION < 5.10.1 } ) # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) \ STMT_START { \ if (sv != ERRSV) \ SvFLAGS(ERRSV) = (SvFLAGS(ERRSV) & ~SVf_UTF8) | \ (SvFLAGS(sv) & SVf_UTF8); \ } STMT_END # else # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) STMT_START {} STMT_END # endif # define croak_sv(sv) \ STMT_START { \ if (SvROK(sv)) { \ sv_setsv(ERRSV, sv); \ croak(NULL); \ } else { \ D_PPP_FIX_UTF8_ERRSV(ERRSV, sv); \ croak("%" SVf, SVfARG(sv)); \ } \ } STMT_END #elif { VERSION >= 5.4.0 } # define croak_sv(sv) croak("%" SVf, SVfARG(sv)) #else # define croak_sv(sv) croak("%s", SvPV_nolen(sv)) #endif #endif

#ifndef die_sv #if { NEED die_sv } OP * die_sv(pTHX_ SV *sv) { croak_sv(sv); return (OP *)NULL; } #endif #endif

#ifndef warn_sv #if { VERSION >= 5.4.0 } # define warn_sv(sv) warn("%" SVf, SVfARG(sv)) #else # define warn_sv(sv) warn("%s", SvPV_nolen(sv)) #endif #endif

#ifndef vmess #if { NEED vmess } SV* vmess(pTHX_ const char* pat, va_list* args) { mess(pat, args); return PL_mess_sv; } #endif #endif

#if { VERSION < 5.6.0 } #undef mess #endif

#if !defined(mess_nocontext) && !defined(Perl_mess_nocontext) #if { NEED mess_nocontext } SV* mess_nocontext(const char* pat, ...) { dTHX; SV *sv; va_list args; va_start(args, pat); sv = vmess(pat, &args); va_end(args); return sv; } #endif #endif

#ifndef mess #if { NEED mess } SV* mess(pTHX_ const char* pat, ...) { SV *sv; va_list args; va_start(args, pat); sv = vmess(pat, &args); va_end(args); return sv; } #ifdef mess_nocontext #define mess mess_nocontext #else #define mess Perl_mess_nocontext #endif #endif #endif

#ifndef mess_sv #if { NEED mess_sv } SV * mess_sv(pTHX_ SV *basemsg, bool consume) { SV *tmp; SV *ret;

    if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
        if (consume)
            return basemsg;
        ret = mess("");
        SvSetSV_nosteal(ret, basemsg);
        return ret;
    }

    if (consume) {
        sv_catsv(basemsg, mess(""));
        return basemsg;
    }

    ret = mess("");
    tmp = newSVsv(ret);
    SvSetSV_nosteal(ret, basemsg);
    sv_catsv(ret, tmp);
    sv_dec(tmp);
    return ret;
}
#endif
#endif

#ifndef warn_nocontext #define warn_nocontext warn #endif

#ifndef croak_nocontext #define croak_nocontext croak #endif

#ifndef croak_no_modify #define croak_no_modify() croak_nocontext("%s", PL_no_modify) #define Perl_croak_no_modify() croak_no_modify() #endif

#ifndef croak_memory_wrap #if { VERSION >= 5.9.2 } || ( { VERSION >= 5.8.6 } && { VERSION < 5.9.0 } ) # define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap) #else # define croak_memory_wrap() croak_nocontext("panic: memory wrap") #endif #endif

#ifndef croak_xs_usage #if { NEED croak_xs_usage }

#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) #endif

void croak_xs_usage(const CV *const cv, const char *const params) { dTHX; const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
            croak("Usage: %s::%s(%s)", hvname, gvname, params);
        else
            croak("Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
        croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
    }
}
#endif
#endif

#define NEED_die_sv #define NEED_mess_sv #define NEED_croak_xs_usage

void croak_sv(sv) SV *sv CODE: croak_sv(sv);

void die_sv(sv) SV *sv CODE: (void)die_sv(sv);

void warn_sv(sv) SV *sv CODE: warn_sv(sv);

SV * mess_sv(sv, consume) SV *sv bool consume CODE: RETVAL = newSVsv(mess_sv(sv, consume)); OUTPUT: RETVAL

void croak_no_modify() CODE: croak_no_modify();

void croak_memory_wrap() CODE: croak_memory_wrap();

void croak_xs_usage(params) char *params CODE: croak_xs_usage(cv, params);

BEGIN { if ($] lt '5.006') { $^W = 0; } }

my $warn; my $die; local $SIG{__WARN__} = sub { $warn = $_[0] }; local $SIG{__DIE__} = sub { $die = $_[0] };

my $scalar_ref = \do {my $tmp = 10}; my $array_ref = []; my $hash_ref = {}; my $obj = bless {}, 'Package';

undef $die; ok !defined eval { Devel::PPPort::croak_sv("\xE1\n") }; ok $@, "\xE1\n"; ok $die, "\xE1\n";

undef $die; ok !defined eval { Devel::PPPort::croak_sv(10) }; ok $@ =~ /^10 at $0 line /; ok $die =~ /^10 at $0 line /;

undef $die; $@ = 'should not be visible (1)'; ok !defined eval { $@ = 'should not be visible (2)'; Devel::PPPort::croak_sv(''); }; ok $@ =~ /^ at $0 line /; ok $die =~ /^ at $0 line /;

undef $die; $@ = 'should not be visible'; ok !defined eval { $@ = 'this must be visible'; Devel::PPPort::croak_sv($@) }; ok $@ =~ /^this must be visible at $0 line /; ok $die =~ /^this must be visible at $0 line /;

undef $die; $@ = 'should not be visible'; ok !defined eval { $@ = "this must be visible\n"; Devel::PPPort::croak_sv($@) }; ok $@, "this must be visible\n"; ok $die, "this must be visible\n";

undef $die; ok !defined eval { Devel::PPPort::croak_sv('') }; ok $@ =~ /^ at $0 line /; ok $die =~ /^ at $0 line /;

undef $die; ok !defined eval { Devel::PPPort::croak_sv("\xE1") }; ok $@ =~ /^\xE1 at $0 line /; ok $die =~ /^\xE1 at $0 line /;

undef $die; ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") }; ok $@ =~ /^\xC3\xA1 at $0 line /; ok $die =~ /^\xC3\xA1 at $0 line /;

undef $warn; Devel::PPPort::warn_sv("\xE1\n"); ok $warn, "\xE1\n";

undef $warn; Devel::PPPort::warn_sv(10); ok $warn =~ /^10 at $0 line /;

undef $warn; Devel::PPPort::warn_sv(''); ok $warn =~ /^ at $0 line /;

undef $warn; Devel::PPPort::warn_sv("\xE1"); ok $warn =~ /^\xE1 at $0 line /;

undef $warn; Devel::PPPort::warn_sv("\xC3\xA1"); ok $warn =~ /^\xC3\xA1 at $0 line /;

ok Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n"; ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";

ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at $0 line /; ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at $0 line /;

ok Devel::PPPort::mess_sv('', 0) =~ /^ at $0 line /; ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at $0 line /;

ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at $0 line /; ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at $0 line /;

ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at $0 line /; ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at $0 line /;

if ($] ge '5.006') { BEGIN { if ($] ge '5.006' && $] lt '5.008') { require utf8; utf8->import(); } }

    undef $die;
    ok !defined eval { Devel::PPPort::croak_sv("\x{100}\n") };
    ok $@, "\x{100}\n";
    if ($] ne '5.008') {
        ok $die, "\x{100}\n";
    } else {
        skip 'skip: broken utf8 support in die hook', 0;
    }

    undef $die;
    ok !defined eval { Devel::PPPort::croak_sv("\x{100}") };
    ok $@ =~ /^\x{100} at $0 line /;
    if ($] ne '5.008') {
        ok $die =~ /^\x{100} at $0 line /;
    } else {
        skip 'skip: broken utf8 support in die hook', 0;
    }

    if ($] ne '5.008') {
        undef $warn;
        Devel::PPPort::warn_sv("\x{100}\n");
        ok $warn, "\x{100}\n";

        undef $warn;
        Devel::PPPort::warn_sv("\x{100}");
        ok (my $tmp = $warn) =~ /^\x{100} at $0 line /;
    } else {
        skip 'skip: broken utf8 support in warn hook', 0 for 1..2;
    }

    ok Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
    ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";

    ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at $0 line /;
    ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at $0 line /;
} else {
    skip 'skip: no utf8 support', 0 for 1..12;
}

if (ord('A') != 65) { skip 'skip: no ASCII support', 0 for 1..24; } elsif ($] ge '5.008' && $] ne '5.012000') { undef $die; ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}\n"') }; ok $@, "\xE1\n"; ok $die, "\xE1\n";

    undef $die;
    ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}"') };
    ok $@ =~ /^\xE1 at $0 line /;
    ok $die =~ /^\xE1 at $0 line /;

    {
        undef $die;
        my $expect = eval '"\N{U+C3}\N{U+A1}\n"';
        ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1\n") };
        ok $@, $expect;
        ok $die, $expect;
    }

    {
        undef $die;
        my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
        ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
        ok $@ =~ $expect;
        ok $die =~ $expect;
    }

    undef $warn;
    Devel::PPPort::warn_sv(eval '"\N{U+E1}\n"');
    ok $warn, "\xE1\n";

    undef $warn;
    Devel::PPPort::warn_sv(eval '"\N{U+E1}"');
    ok $warn =~ /^\xE1 at $0 line /;

    undef $warn;
    Devel::PPPort::warn_sv("\xC3\xA1\n");
    ok $warn, eval '"\N{U+C3}\N{U+A1}\n"';

    undef $warn;
    Devel::PPPort::warn_sv("\xC3\xA1");
    ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';

    ok Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
    ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';

    ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at $0 line /';
    ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at $0 line /';

    ok Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
    ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';

    ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
    ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
} else {
    skip 'skip: no support for \N{U+..} syntax', 0 for 1..24;
}

if ($] ge '5.007003' or ($] ge '5.006001' and $] lt '5.007')) { undef $die; ok !defined eval { Devel::PPPort::croak_sv($scalar_ref) }; ok $@ == $scalar_ref; ok $die == $scalar_ref;

    undef $die;
    ok !defined eval { Devel::PPPort::croak_sv($array_ref) };
    ok $@ == $array_ref;
    ok $die == $array_ref;

    undef $die;
    ok !defined eval { Devel::PPPort::croak_sv($hash_ref) };
    ok $@ == $hash_ref;
    ok $die == $hash_ref;

    undef $die;
    ok !defined eval { Devel::PPPort::croak_sv($obj) };
    ok $@ == $obj;
    ok $die == $obj;
} else {
    skip 'skip: no support for exceptions', 0 for 1..12;
}

ok !defined eval { Devel::PPPort::croak_no_modify() }; ok $@ =~ /^Modification of a read-only value attempted at $0 line /;

ok !defined eval { Devel::PPPort::croak_memory_wrap() }; ok $@ =~ /^panic: memory wrap at $0 line /;

ok !defined eval { Devel::PPPort::croak_xs_usage("params") }; ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at $0 line /;

6 POD Errors

The following errors were encountered while parsing the POD:

Around line 10:

Unknown directive: =provides

Around line 33:

Unknown directive: =dontwarn

Around line 39:

Unknown directive: =implementation

Around line 233:

Unknown directive: =xsinit

Around line 239:

Unknown directive: =xsubs

Around line 284:

Unknown directive: =tests