The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
BEGIN {
    $^W = 1;
    $| = 1;
    $SIG{INT} = sub { die };
    print "1..6\n";
}

use strict;
use Carp;
use IPC::Shareable;

my $t  = 1;
my $ok = 1;


{
    package Dummy;
    
    sub new {
	my $d = {
	    _first  => undef,
	    _second => undef,
	};
	return bless $d => shift;
    }

    sub first {
	my $self = shift;
	$self->{_first} = shift if @_;
	return $self->{_first};
    }

    sub second {
	my $self = shift;
	$self->{_second} = shift if @_;
	return $self->{_second};
    }
}

my $awake = 0;
local $SIG{ALRM} = sub { $awake = 1 };

my $pid = fork;
defined $pid or die "Cannot fork : $!";
if ($pid == 0) {
    # --- Child
    sleep unless $awake;
    my $d;

    ++$t;
    tie($d, 'IPC::Shareable', 'obj', { destroy => 0 })
	or undef $ok;
    $ok = (ref $d eq 'Dummy');
    print $ok ? "ok $t\n" : "not ok $t\n";

    ++$t;
    $ok = ($d->first eq 'foobar');
    print $ok ? "ok $t\n" : "not ok $t\n";

    ++$t;
    $ok = ($d->second eq 'barfoo');
    print $ok ? "ok $t\n" : "not ok $t\n";

    $d->first('kid did');
    $d->second('this');

    exit;
} else {
    # --- Parent
    my $d;
    my $s = tie($d, 'IPC::Shareable', 'obj', { create => 'yes', destroy => 'yes' })
	or undef $ok;
    my $id = $s->{_shm}->{_id};
    print $ok ? "ok $t\n" : "not ok $t\n";

    $d = { };
    $d->{_first} = 'foobar';
    $d->{_second} = 'barfoo';

    $d = Dummy->new;
    $d->first('foobar');
    $d->second('barfoo');

    kill ALRM => $pid;
    waitpid($pid, 0);

    $t += 3; # - Child did 3 test

    ++$t;
    $ok = ($d->first eq 'kid did');
    print $ok ? "ok $t\n" : "not ok $t\n";

    ++$t;
    $ok = ($d->second eq 'this');
    print $ok ? "ok $t\n" : "not ok $t\n";

    IPC::Shareable->clean_up_all;
}

# --- Done!
exit;