view release on metacpan or  search on metacpan

lib/Acme/Parataxis.c  view on Meta::CPAN

 */
static void para_report_avreal_pad(pTHX_ CV * cv, I32 depth, const char * where) {
    if (!cv || SvTYPE((SV *)cv) != SVt_PVCV)
        return;
    const char * pkg = (CvSTASH(cv) && HvNAME_get(CvSTASH(cv))) ? HvNAME_get(CvSTASH(cv)) : "?";
    const char * name = "?";
    GV * gv = CvGV(cv);
    if (gv && isGV_with_GP(gv) && GvNAME_HEK(gv))
        name = GvNAME(gv);
#ifdef DEBUGGING
    fprintf(stderr, "PARATAXIS_PAD: %s %s::%s depth=%ld\n", where, pkg, name, (long)depth);
#else
    PERL_UNUSED_VAR(pkg);
    PERL_UNUSED_VAR(name);
#endif
}

/**
 * @brief DEBUGGING-only: report every just-parked fiber sub-frame whose pad @_ (slot 0) is AvREAL.
 *
 * Called from swap_perl_state after the depositing fiber's context stack has been recaptured, i.e. for every

lib/Acme/Parataxis.c  view on Meta::CPAN

}

/* diagnostic: PARA_DIAG=1 dumps swap-time depth/pad state */
static int para_diag_enabled(void) {
    static int on = -1;
    if (on < 0)
        on = (getenv("PARA_DIAG") != NULL);
    return on;
}

#define PARA_DIAGF(...) do { if (para_diag_enabled()) fprintf(stderr, __VA_ARGS__); } while (0)

/** @brief Monotonic swap counter, so the PARA_DIAG dumps from one swap can be told apart. */
static unsigned long para_diag_swapno = 0;

/* ------------------------------------------------------------------------------------------
 * Parked-frame depth registry.
 *
 * CvDEPTH is a single per-CV counter, but every fiber that parks inside a subroutine leaves a
 * live frame (and a live pad) behind in the shared PadList. pp_entersub allocates its pad as
 * depth = ++CvDEPTH(cv) and Perl_pad_push() reuses an existing pad at that depth as-is, so any

t/356_parked_depth.t  view on Meta::CPAN

# claims are purged by destroy_coro and settled by the next swap's Pass 1c, and the never-destroyed-fiber
# case is covered by para_cvreg_purge_fiber() at the deadlock and failed-run epilogue points (56b956e).
# This file now only guards the two original defect cases above.
sub run_child {
    my ($body) = @_;
    my $log    = File::Temp->new( SUFFIX => '.log' );
    my $code   = join "\n", 'use v5.40;', 'use blib;', 'use Acme::Parataxis qw[:all];', '$|++;', $body, '';
    my $status;
    {
        open my $saved_out, '>&', \*STDOUT or die "dup stdout: $!";
        open my $saved_err, '>&', \*STDERR or die "dup stderr: $!";
        open STDOUT,        '>',  "$log"   or die "open log: $!";
        open STDERR,        '>&', \*STDOUT or die "dup stderr: $!";
        $status = system $^X, '-Mblib', '-e', $code;
        open STDOUT, '>&', $saved_out or die "restore stdout: $!";
        open STDERR, '>&', $saved_err or die "restore stderr: $!";
    }
    open my $fh, '<', "$log" or die "read log: $!";
    my $out = do { local $/; <$fh> };
    return ( $out, $status );
}

# The shared assertion. Returns nothing; the three checks are the contract.
sub check_clean {
    my ( $out, $status, $label ) = @_;
    like( $out, qr/\bWORKED\b/, "$label: the work completed" );