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;