Acme-Parataxis
view release on metacpan or search on metacpan
## [v0.0.3] - 2026-02-17
### Changed
- Adding an optional timeout to `await_read` and `await_write`.
- Allow fibers to return complex data (AV*, HV*).
## [v0.0.2] - 2026-02-17
### Fixed
- Fixed segfault in `coro_yield` by adding NULL checks for destroyed or missing fibers.
- Resolved stall in exception handling by introducing `last_sender` tracking to prevent `parent_id` cycles.
### Changed
- Made unit tests a lot more noisy
## [v0.0.1] - 2026-02-16
### Changes
- It exists! It shouldn't but it does.
Fibers can pass data back and forth through `call` and `yield`:
- **Resuming with a value**: Arguments passed to `$fiber->call(@args)` are returned by the `yield( )` call that
suspended the fiber.
- **Yielding with a value**: Arguments passed to `Acme::Parataxis->yield(@args)` are returned to the caller by
the `call( )` that resumed the fiber.
## Full Coroutines
Fibers in Parataxis are "full coroutines." This means they can suspend from anywhere in the callstack. You can call
`yield( )` from deeply nested functions, and the entire fiber stack will be suspended until the fiber is resumed.
## Transferring Control
While `call( )` and `yield( )` manage a stack-like chain of execution, `transfer( )` provides an unstructured way to
switch between fibers. When you transfer to a fiber, the current one is suspended, and the target fiber resumes. Unlike
`call( )`, transferring does not establish a parent/child relationship. It's more like a `goto` for execution
contexts.
```
Returns the unique OS Thread ID of the main interpreter thread.
## `current_fid( )`
Returns the unique numeric ID of the currently executing fiber, or -1 if called from the "root" (main) context.
## `root( )`
Returns a proxy object representing the initial execution context. This is useful for `transfer( )`ing control back to
the main thread from a symmetric coroutine.
# Acme::Parataxis OBJECT METHODS
## `fid( )`
Returns the unique numeric ID of the fiber object.
## `is_done( )`
Returns true if the fiber has finished execution (either by returning or dying). Once a fiber is done, its internal ID
exceptions within fibers.
## Signal Handling
Signals are delivered to the main process thread. Perl handles these at 'safe points,' which in this module typically
occur during a context switch (yield, transfer, or call). If you send a signal while a fiber is suspended, it will
generally be processed when the fiber is resumed and hits the next internal Perl opcode.
## The 'Final Transfer' Requirement
In a symmetric coroutine model (using `transfer( )`), fibers don't have a natural 'parent' to return to. I've added
fallback logic to return to the `last_sender` or the main thread on exit but it's good practice to explicitly
`transfer( )` back to a partner fiber or the `root( )` context to ensure your application logic remains predictable.
Leaving a fiber to just 'fall off the end' is like walking out of a room without closing the door; eventually, the
draft will bother someone.
## `is_done( )` vs. Destruction
A fiber being `is_done( )` simply means its Perl code has finished executing. The underlying C-level memory (stacks,
context, etc.) is not immediately freed until the `Acme::Parataxis` object is destroyed or the runtime performs its
final `cleanup( )`. This is why you might see memory usage stay flat even after a fiber finishes, until the garbage
eg/socket.pl view on Meta::CPAN
use v5.40;
use blib;
$|++;
use Acme::Parataxis;
use IO::Socket::INET;
# Create a simple echo server in a coroutine
Acme::Parataxis::run(
sub {
my $server = IO::Socket::INET->new( LocalAddr => '127.0.0.1', LocalPort => 9999, Proto => 'tcp', Listen => 5, Reuse => 1 ) or
die 'Could not create server: ' . $!;
$server->blocking(0);
$server->autoflush(1);
say 'Server listening on 127.0.0.1:9999';
my $client_done = 0;
Acme::Parataxis->spawn(
sub {
eg/symmetric.pl view on Meta::CPAN
use v5.40;
use blib;
use Acme::Parataxis;
# Symmetric coroutines (Producer/Consumer)
my ( $producer, $consumer );
$producer = Acme::Parataxis->new(
code => sub {
for my $item (qw[Apple Banana Cherry]) {
say "Producer: Created $item. Transferring to Consumer...";
$consumer->transfer($item);
say 'Producer: Consumer gave control back. Moving to next item.';
}
say 'Producer: Out of items. Telling consumer to finish.';
$consumer->transfer(undef);
lib/Acme/Parataxis.c view on Meta::CPAN
#define PERL_NO_GET_CONTEXT
#define NO_XSLOCKS
#include "EXTERN.h"
#include "XSUB.h"
#include "perl.h"
#ifdef _WIN32
/** @brief Export macro for Windows DLLs */
#define DLLEXPORT __declspec(dllexport)
/** @brief Handle for the underlying OS fiber context */
typedef LPVOID coro_handle_t;
/** @brief Handle for a native OS thread */
typedef HANDLE para_thread_t;
/** @brief Mutex type for queue synchronization */
typedef CRITICAL_SECTION para_mutex_t;
#define LOCK(m) EnterCriticalSection(&m)
#define UNLOCK(m) LeaveCriticalSection(&m)
#define LOCK_INIT(m) InitializeCriticalSection(&m)
#else
#include <pthread.h>
#include <sched.h>
lib/Acme/Parataxis.c view on Meta::CPAN
#include <sys/time.h>
#include <ucontext.h>
#include <unistd.h>
#if defined(__APPLE__) || defined(__FreeBSD__)
#include <sys/sysctl.h>
#include <sys/types.h>
#endif
/** @brief Export macro for Unix systems */
#define DLLEXPORT __attribute__((visibility("default")))
/** @brief Handle for the underlying OS fiber context (ucontext_t) */
typedef ucontext_t coro_handle_t;
/** @brief Handle for a native OS thread (pthread_t) */
typedef pthread_t para_thread_t;
/** @brief Mutex type for queue synchronization (pthread_mutex_t) */
typedef pthread_mutex_t para_mutex_t;
#define LOCK(m) pthread_mutex_lock(&m)
#define UNLOCK(m) pthread_mutex_unlock(&m)
#define LOCK_INIT(m) pthread_mutex_init(&m, NULL)
#endif
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdlib.h>
#include <string.h>
// Forward declarations
DLLEXPORT SV * coro_yield(SV * ret_val);
DLLEXPORT SV * coro_transfer(int fiber_id, SV * args);
DLLEXPORT void destroy_coro(int fiber_id);
/**
* @brief Get the Operating System's unique Thread ID.
*
* Useful for debugging to prove that background tasks are running on
* different OS threads than the main Perl interpreter.
*
* @return int The TID (Windows) or LWP ID (Linux/BSD/macOS).
*/
int get_os_thread_id() {
lib/Acme/Parataxis.c view on Meta::CPAN
/**
* @struct para_fiber_t
* @brief The complete execution context of a Perl Fiber.
*
* This structure encapsulates both the OS-level register state (via context)
* and the entire internal state of the Perl interpreter required to pause
* and resume execution of Perl code.
*/
typedef struct {
coro_handle_t context; /**< OS-specific context handle */
#ifndef _WIN32
void * stack_p; /**< Pointer to dynamically allocated fiber stack (Unix only) */
size_t stack_sz; /**< Size of the allocated stack (Unix only) */
#endif
/*
* Perl Interpreter State Pointers.
* These must be saved and restored during every context switch.
*/
lib/Acme/Parataxis.c view on Meta::CPAN
UNLOCK(queue_lock);
return res;
}
/**
* @brief Gets the ID of the Fiber that submitted a specific job.
*
* @param idx Job index.
* @return int Fiber ID.
*/
DLLEXPORT int get_job_coro_id(int idx) {
if (idx < 0 || idx >= MAX_JOBS)
return -1;
return job_slots[idx].fiber_id;
}
/**
* @brief Frees a job slot in the queue after the result has been retrieved.
*
* @param idx Job index.
*/
lib/Acme/Parataxis.c view on Meta::CPAN
DLLEXPORT int get_max_thread_pool_size() { return max_thread_pool_size; }
/** @brief Sets the threshold for automatic yield-based preemption. */
DLLEXPORT void set_preempt_threshold(int64_t threshold) { preempt_threshold = threshold; }
/** @brief Returns the current count towards the preemption threshold. */
DLLEXPORT int64_t get_preempt_count() { return preempt_count; }
/**
* @brief Checks if automatic preemption should occur.
*
* Increments the internal counter and triggers a `coro_yield` if the
* threshold is reached.
*
* @return SV* Result of the yield, or undef if no yield occurred.
*/
DLLEXPORT SV * maybe_yield() {
dTHX;
preempt_count++;
if (preempt_threshold > 0 && preempt_count >= preempt_threshold) {
preempt_count = 0;
return coro_yield(&PL_sv_undef);
}
return &PL_sv_undef;
}
/**
* @brief Restores subroutine call depths and cleans argument pads.
*
* This function iterates the context stack and restores CvDEPTH for
* active subroutines in two passes to safely handle recursive calls.
*
lib/Acme/Parataxis.c view on Meta::CPAN
/**
* @brief Yields execution back to the caller or the main thread.
*
* Suspends the current fiber and returns a value to the context that
* last resumed or called this fiber.
*
* @param ret_val The Perl SV to "return" to the caller.
* @return SV* The value passed in when this fiber is eventually resumed.
*/
DLLEXPORT SV * coro_yield(SV * ret_val) {
dTHX;
if (current_fiber_id == -1)
return &PL_sv_undef;
para_fiber_t * self = fibers[current_fiber_id];
int parent = self->parent_id;
if (parent != -1 && (!fibers[parent] || fibers[parent]->finished))
parent = self->last_sender;
else if (parent == -1)
parent = self->last_sender;
if (parent >= 0 && (!fibers[parent] || fibers[parent]->finished))
lib/Acme/Parataxis.c view on Meta::CPAN
*
* @param c Pointer to the fiber context being started.
*/
static void entry_point(para_fiber_t * c) {
dTHX;
ENTER;
SAVETMPS;
dSP;
PUSHMARK(SP);
/* Unpack arguments passed during coro_call */
if (c->transfer_data && SvROK(c->transfer_data) && SvTYPE(SvRV(c->transfer_data)) == SVt_PVAV) {
AV * args = (AV *)SvRV(c->transfer_data);
I32 len = av_top_index(args) + 1;
for (I32 i = 0; i < len; i++) {
SV ** svp = av_fetch(args, i, 0);
if (svp)
XPUSHs(*svp);
}
}
PUTBACK;
lib/Acme/Parataxis.c view on Meta::CPAN
PUTBACK;
call_method("set_result", G_DISCARD);
}
FREETMPS;
LEAVE;
}
FREETMPS;
LEAVE;
/* Final yield back to caller */
coro_yield(c->transfer_data ? c->transfer_data : &PL_sv_undef);
/* Loop indefinitely if resumed after finish */
while (1)
coro_yield(&PL_sv_undef);
}
#ifdef _WIN32
/** @brief Windows fiber callback wrapper. */
static void WINAPI fiber_entry(void * param) { entry_point((para_fiber_t *)param); }
#else
/** @brief POSIX makecontext callback wrapper. */
static void posix_entry(int fiber_id) { entry_point(fibers[fiber_id]); }
#endif
lib/Acme/Parataxis.c view on Meta::CPAN
fibers[idx] = c;
/* Initialize Perl stacks */
init_perl_stacks(c);
#ifdef _WIN32
c->context = CreateFiber(0, fiber_entry, c);
#else
c->stack_sz = 512 * 1024; // 512KB is plenty for Perl fibers
if (posix_memalign(&c->stack_p, 16, c->stack_sz) != 0) {
destroy_coro(idx);
return -3;
}
getcontext(&c->context);
c->context.uc_stack.ss_sp = c->stack_p;
c->context.uc_stack.ss_size = c->stack_sz;
c->context.uc_link = &main_context.context;
makecontext(&c->context, (void (*)())posix_entry, 1, c->id);
#endif
return idx;
}
lib/Acme/Parataxis.c view on Meta::CPAN
/**
* @brief Resumes a fiber (asymmetric call).
*
* Suspends the caller and switches execution to the specified fiber.
* Sets the caller as the 'parent' for future yields.
*
* @param fiber_id Fiber ID to call.
* @param args Perl SV (usually arrayref) to pass as arguments to the fiber.
* @return SV* Result yielded by the fiber.
*/
DLLEXPORT SV * coro_call(int fiber_id, SV * args) {
dTHX;
if (fiber_id < 0 || fiber_id >= MAX_FIBERS || !fibers[fiber_id] || fibers[fiber_id]->finished)
return &PL_sv_undef;
if (fibers[fiber_id]->transfer_data != args) {
if (fibers[fiber_id]->transfer_data && fibers[fiber_id]->transfer_data != &PL_sv_undef)
SvREFCNT_dec(fibers[fiber_id]->transfer_data);
fibers[fiber_id]->transfer_data = args;
if (args && args != &PL_sv_undef)
SvREFCNT_inc(args);
}
lib/Acme/Parataxis.c view on Meta::CPAN
/**
* @brief Transfers control directly to another fiber (symmetric).
*
* Suspends the current fiber and switches directly to the target. No
* parent/child relationship is established.
*
* @param target_id Fiber ID to transfer to.
* @param args Arguments to pass to the target.
* @return SV* Data eventually transferred back to this fiber.
*/
DLLEXPORT SV * coro_transfer(int target_id, SV * args) {
dTHX;
if (target_id < -1 || (target_id >= 0 && (target_id >= MAX_FIBERS || !fibers[target_id])))
return &PL_sv_undef;
if (target_id >= 0 && fibers[target_id]->finished)
return &PL_sv_undef;
para_fiber_t * target = (target_id == -1) ? &main_context : fibers[target_id];
if (target->transfer_data != args) {
if (target->transfer_data && target->transfer_data != &PL_sv_undef)
SvREFCNT_dec(target->transfer_data);
target->transfer_data = args;
lib/Acme/Parataxis.c view on Meta::CPAN
}
/**
* @brief Destroys a fiber and releases all associated memory.
*
* This includes freeing OS-level stacks and context, but also carefully
* decrementing refcounts of Perl SVs stored within the fiber.
*
* @param fiber_id Fiber ID to destroy.
*/
DLLEXPORT void destroy_coro(int fiber_id) {
dTHX;
if (fiber_id < 0 || fiber_id >= MAX_FIBERS)
return;
para_fiber_t * c = fibers[fiber_id];
if (!c)
return;
fibers[fiber_id] = NULL;
/* Unwind pads */
if (c->si)
lib/Acme/Parataxis.c view on Meta::CPAN
usleep(10000);
#endif
}
if (current_fiber_id != -1) {
swap_perl_state(fibers[current_fiber_id], &main_context);
current_fiber_id = -1;
}
for (int i = 0; i < MAX_FIBERS; i++)
if (fibers[i])
destroy_coro(i);
if (main_context.transfer_data && main_context.transfer_data != &PL_sv_undef) {
SvREFCNT_dec(main_context.transfer_data);
main_context.transfer_data = &PL_sv_undef;
}
}
lib/Acme/Parataxis.pm view on Meta::CPAN
);
#
our @IPC_BUFFER;
my $lib;
my @SCHEDULER_QUEUE;
my $IS_RUNNING = 0;
sub _bind_functions ($l) {
affix $l, 'init_system', [], Int;
affix $l, 'create_fiber', [ Pointer [SV], Pointer [SV] ], Int;
affix $l, 'coro_call', [ Int, Pointer [SV] ], Pointer [SV];
affix $l, 'coro_transfer', [ Int, Pointer [SV] ], Pointer [SV];
affix $l, 'coro_yield', [ Pointer [SV] ], Pointer [SV];
affix $l, 'is_finished', [Int], Int;
affix $l, 'destroy_coro', [Int], Void;
affix $l, 'force_depth_zero', [ Pointer [SV] ], Void;
affix $l, 'cleanup', [], Void;
affix $l, 'get_os_thread_id_export', [], Int;
affix $l, 'get_current_parataxis_id', [], Int;
affix $l, 'submit_c_job', [ Int, LongLong, Int ], Int;
affix $l, 'check_for_completion', [], Int;
affix $l, 'get_job_result', [Int], Pointer [SV];
affix $l, 'get_job_coro_id', [Int], Int;
affix $l, 'free_job_slot', [Int], Void;
affix $l, 'get_thread_pool_size', [], Int;
affix $l, 'get_max_thread_pool_size', [], Int;
affix $l, 'set_max_threads', [Int], Void;
affix $l, 'set_preempt_threshold', [LongLong], Void;
affix $l, [ 'maybe_yield' => '_maybe_yield' ], [], Pointer [SV];
affix $l, 'get_preempt_count', [], LongLong;
# Capture the main interpreter context eagerly
init_system();
lib/Acme/Parataxis.pm view on Meta::CPAN
}
croak 'await() requires a Future or Fiber object';
}
sub yield {
my $invocant = shift;
if ( !defined $invocant || ( ( ref $invocant || $invocant ) ne 'Acme::Parataxis' && !eval { $invocant->isa('Acme::Parataxis') } ) ) {
unshift @_, $invocant if defined $invocant;
$invocant = 'Acme::Parataxis';
}
my $result = coro_yield( \@_ );
return unless defined $result;
return ( ref $result eq 'ARRAY' ) ? ( wantarray ? @$result : $result->[-1] ) : $result;
}
sub spawn {
my ( $class, $code ) = @_;
if ( ref $class eq 'CODE' ) {
$code = $class;
$class = 'Acme::Parataxis';
}
lib/Acme/Parataxis.pm view on Meta::CPAN
if ( my $fiber = Acme::Parataxis->by_id($fid) ) {
push @SCHEDULER_QUEUE, $fiber;
}
}
sub poll_io {
my @ready;
while (1) {
my $job_idx = check_for_completion();
last if $job_idx == -1;
my $fid = get_job_coro_id($job_idx);
my $res = get_job_result($job_idx);
push @ready, [ $fid, $res ];
free_job_slot($job_idx);
}
return @ready;
}
sub run ($code) {
@SCHEDULER_QUEUE = ();
$IS_RUNNING = 1;
lib/Acme/Parataxis.pm view on Meta::CPAN
our %REGISTRY;
ADJUST {
Acme::Parataxis::force_depth_zero($code);
$fid = Acme::Parataxis::create_fiber( $code, $self );
$REGISTRY{$fid} = $self;
builtin::weaken $REGISTRY{$fid};
}
method call (@args) {
croak 'Cannot call a finished fiber' if $is_done;
my $rv = Acme::Parataxis::coro_call( $fid, \@args );
return unless defined $self;
if ( $self->is_done ) {
my $err = $error;
die $err if defined $err;
}
return unless defined $rv;
return ( ref $rv eq 'ARRAY' ) ? ( wantarray ? @$rv : $rv->[-1] ) : $rv;
}
method transfer (@args) {
croak 'Cannot transfer to a finished fiber' if $self->is_done;
my $rv = Acme::Parataxis::coro_transfer( $fid, \@args );
if ( $self->is_done ) {
my $err = $error;
die $err if defined $err;
}
return unless defined $rv;
return ( ref $rv eq 'ARRAY' ) ? ( wantarray ? @$rv : $rv->[-1] ) : $rv;
}
method is_done () {
return 1 if $is_done;
if ( defined $fid && $fid >= 0 && Acme::Parataxis::is_finished($fid) ) {
$is_done = 1;
my $old_fid = $fid;
$fid = -1;
delete $REGISTRY{$old_fid};
Acme::Parataxis::destroy_coro($old_fid);
return 1;
}
return 0;
}
method wait () {
while ( !$self->is_done ) {
Acme::Parataxis->yield('WAITING_FOR_CHILD');
}
return $self->result;
}
method DESTROY {
return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
if ( defined $fid && $fid >= 0 ) {
delete $REGISTRY{$fid};
Acme::Parataxis::destroy_coro($fid);
$fid = -1;
}
}
sub by_id ( $class, $fid ) { $REGISTRY{$fid} }
}
class #
Acme::Parataxis::Root {
method transfer (@args) {
my $rv = Acme::Parataxis::coro_transfer( -1, \@args );
return unless defined $rv;
return ( ref $rv eq 'ARRAY' ) ? ( wantarray ? @$rv : $rv->[-1] ) : $rv;
}
method fid () {-1}
}
class #
Acme::Parataxis::Future {
use Carp qw[croak];
field $is_ready : reader = 0;
field $result;
lib/Acme/Parataxis.pod view on Meta::CPAN
=item * B<Resuming with a value>: Arguments passed to C<$fiber-E<gt>call(@args)> are returned by the C<yield( )> call that
suspended the fiber.
=item * B<Yielding with a value>: Arguments passed to C<Acme::Parataxis-E<gt>yield(@args)> are returned to the caller by
the C<call( )> that resumed the fiber.
=back
=head2 Full Coroutines
Fibers in Parataxis are "full coroutines." This means they can suspend from anywhere in the callstack. You can call
C<yield( )> from deeply nested functions, and the entire fiber stack will be suspended until the fiber is resumed.
=head2 Transferring Control
While C<call( )> and C<yield( )> manage a stack-like chain of execution, C<transfer( )> provides an unstructured way to
switch between fibers. When you transfer to a fiber, the current one is suspended, and the target fiber resumes. Unlike
C<call( )>, transferring does not establish a parent/child relationship. It's more like a C<goto> for execution
contexts.
$other_fiber->transfer( );
lib/Acme/Parataxis.pod view on Meta::CPAN
Returns the unique OS Thread ID of the main interpreter thread.
=head2 C<current_fid( )>
Returns the unique numeric ID of the currently executing fiber, or -1 if called from the "root" (main) context.
=head2 C<root( )>
Returns a proxy object representing the initial execution context. This is useful for C<transfer( )>ing control back to
the main thread from a symmetric coroutine.
=head1 Acme::Parataxis OBJECT METHODS
=head2 C<fid( )>
Returns the unique numeric ID of the fiber object.
=head2 C<is_done( )>
Returns true if the fiber has finished execution (either by returning or dying). Once a fiber is done, its internal ID
lib/Acme/Parataxis.pod view on Meta::CPAN
exceptions within fibers.
=head2 Signal Handling
Signals are delivered to the main process thread. Perl handles these at 'safe points,' which in this module typically
occur during a context switch (yield, transfer, or call). If you send a signal while a fiber is suspended, it will
generally be processed when the fiber is resumed and hits the next internal Perl opcode.
=head2 The 'Final Transfer' Requirement
In a symmetric coroutine model (using C<transfer( )>), fibers don't have a natural 'parent' to return to. I've added
fallback logic to return to the C<last_sender> or the main thread on exit but it's good practice to explicitly
C<transfer( )> back to a partner fiber or the C<root( )> context to ensure your application logic remains predictable.
Leaving a fiber to just 'fall off the end' is like walking out of a room without closing the door; eventually, the
draft will bother someone.
=head2 C<is_done( )> vs. Destruction
A fiber being C<is_done( )> simply means its Perl code has finished executing. The underlying C-level memory (stacks,
context, etc.) is not immediately freed until the C<Acme::Parataxis> object is destroyed or the runtime performs its
final C<cleanup( )>. This is why you might see memory usage stay flat even after a fiber finishes, until the garbage
t/001_basic.t view on Meta::CPAN
use v5.40;
use blib;
use Acme::Parataxis;
use Test2::V1 -ipP;
$|++;
#
diag '$Acme::Parataxis::VERSION = ' . $Acme::Parataxis::VERSION;
diag 'Testing basic asymmetric coroutine flow...';
subtest 'Asymmetric Coroutines' => sub {
diag 'Creating a new Acme::Parataxis object (Fiber)...';
my $f = Acme::Parataxis->new(
code => sub ($name) {
diag "Inside fiber. Hello, $name!";
is( $name, 'Alice', 'Received arg' );
diag 'Yielding back to parent...';
my $val = Acme::Parataxis->yield( 'Hello ' . $name );
diag "Resumed in fiber. Received: $val";
is( $val, 'Bob', 'Received resume arg' );
t/002_exceptions.t view on Meta::CPAN
use v5.40;
use Test2::V1 -ipP;
use blib;
use Acme::Parataxis;
use experimental 'class';
$|++;
#
diag 'Testing exception handling in Acme::Parataxis fibers...';
subtest 'Die inside coroutine, catch outside' => sub {
my $fiber = Acme::Parataxis->new(
code => sub {
pass 'Inside the sub. Hang on a sec while I die...';
die 'Death in coro';
}
);
like dies { $fiber->call(); }, qr/Death in coro/, 'Caught exception from coroutine';
ok $fiber->is_done, 'Coroutine is marked as done after die';
};
subtest 'eval inside coroutine' => sub {
my $fiber = Acme::Parataxis->new(
code => sub {
pass 'Inside the sub. Hang on a sec while I die inside an eval...';
eval { die 'Inner death' };
my $err = $@;
return 'Survived: ' . $err;
}
);
like $fiber->call(), qr/Survived: Inner death/, 'Inner eval caught the death';
ok $fiber->is_done, 'Coroutine finished normally';
};
subtest 'try/catch inside coroutine' => sub {
my $fiber = Acme::Parataxis->new(
code => sub {
diag 'Inside fiber: About to try/catch inner death...';
try { die 'Inner death' } catch ($e) {
return 'Survived: ' . $e;
}
}
);
like $fiber->call(), qr/Survived: Inner death/, 'Inner catch block executed';
ok $fiber->is_done, 'Coroutine finished normally';
};
subtest 'Nested coroutines exceptions' => sub {
my $fiber1 = Acme::Parataxis->new(
code => sub {
diag 'Coro1: Spawning Coro2...';
my $fiber2 = Acme::Parataxis->new(
code => sub {
diag 'Coro2: About to die...';
die 'Deep death';
}
);
$fiber2->call();
t/003_signals.t view on Meta::CPAN
use v5.40;
use Test2::V1 -ipP;
use blib;
use Acme::Parataxis;
use experimental 'class';
$|++;
#
skip_all 'Signals on Windows? Ha!', 2 if $^O eq 'MSWin32';
diag 'Testing signal handling during fiber execution...';
subtest 'Signal handled inside coroutine' => sub {
diag 'Case 1: Sending signal while inside a fiber...';
my $signaled = 0;
local $SIG{INT} = sub {
diag 'Parent SIGINT handler reached';
$signaled++;
};
my $fiber = Acme::Parataxis->new(
code => sub {
diag "Inside fiber: About to kill 'INT' self ($$)...";
kill 'INT', $$;
( run in 1.123 second using v1.01-cache-2.11-cpan-2398b32b56e )