view release on metacpan or  search on metacpan

t/68-shared_scalar_complex.t  view on Meta::CPAN

# 15. JSON serializer (IPC::Shareable default) cannot preserve a blessing on
#     cross-process round-trip; the value comes back as a plain HASH ref.
#     Pins the POD warning so we notice if this ever changes upstream.
{
    my $s;
    my $e = $mod->new(0, sub {
        $$s = bless { x => 42 }, 'MyTestClass';
    });
    $s = $e->shared_scalar;

    $e->start;
    $e->wait;

    my $r = eval { ref($$s) } // 'fetch_died';
    isnt $r, 'MyTestClass',
        "blessed object: blessing not preserved cross-process (got=$r) - POD warning";
}

# 16. JSON cannot serialize a CODE ref; either the child callback dies during
#     STORE, or the segment ends up unusable. Either way, the parent cannot
#     get a usable CODE back. Pins the POD warning.
{
    my $s;
    my $e = $mod->new(0, sub {
        $$s = sub { 42 };
    });
    $s = $e->shared_scalar;

    $e->start;
    $e->wait;

    my $r = eval { ref($$s) } // 'fetch_died';
    isnt $r, 'CODE',
        "code ref: not retrievable as CODE cross-process (got=$r, error=" .
        ($e->error ? 1 : 0) . ") - POD warning";
}

# 17. The "Unreliable" pattern documented in the shared_scalar POD: fetch a
#     hashref into a lexical, mutate it, and store it back. Re-storing a
#     tied value into its own parent corrupts the segment; current behavior
#     leaves the hash empty. This test pins that observed behavior so we
#     notice if/when IPC::Shareable changes it.
{
    my $e = $mod->new(0, sub {});
    my $s = $e->shared_scalar;

    $$s = { a => 1, b => 2 };

    my $h = $$s;
    $h->{c} = 3;
    $$s = $h;

    is ref($$s),                          'HASH',
        'mutate-then-store: scalar is still a HASH ref';
    is scalar(keys %{ ref($$s) eq 'HASH' ? $$s : {} }), 0,
        'mutate-then-store: hash ends up empty (pins POD-documented broken pattern)';
}

# 18. Event crash mid-write: the callback writes partial data, then dies.
#     The shared_scalar segment is owned by the event object (still alive),
#     so the partial write survives and the segment remains readable and
#     writable from the parent.
{
    my $s;
    my $e = $mod->new(0, sub {
        $$s = { phase => 'partial' };
        die "callback died after partial write\n";
    });
    $s = $e->shared_scalar;

    $e->start;
    $e->wait;

    ok $e->error,                "crash mid-write: error flag set after callback died";
    is ref($$s),       'HASH',   "crash mid-write: shared_scalar still readable in parent";
    is $$s->{phase},   'partial',"crash mid-write: partial write preserved in segment";

    $$s = { recovered => 1 };
    is $$s->{recovered}, 1,      "crash mid-write: shared_scalar still writable from parent";
}