view release on metacpan or  search on metacpan

t/07-shm_lock.t  view on Meta::CPAN

        is
            $attr_prot,
            $expected_lock,
            "tied knot's in-memory 'protected' attribute equals _shm_lock()";

        my $sem_prot = $knot->sem->getval(SEM_PROTECTED);

        is
            $sem_prot,
            $expected_lock,
            "SEM_PROTECTED on the segment equals _shm_lock() (was silently truncated to 0 before the fix)";

        cmp_ok $sem_prot, '<=', 32767,
            "SEM_PROTECTED value is within the system semaphore range";
    }

    ok $found_protected,
        "at least one segment is marked protected with our lock value";
}

# A forked process inherits $shared_memory_protect_lock from the parent
# (it was captured at module load time, before the fork). The child's
# _shm_lock() must therefore equal the parent's, even though the child's
# $$ is different.

{
    my $parent_lock = Async::Event::Interval::_shm_lock();

    pipe my $rh, my $wh or die "pipe: $!";

    my $pid = fork;
    defined $pid or die "fork: $!";

    if ($pid == 0) {
        # child
        close $rh;
        print $wh Async::Event::Interval::_shm_lock(), "\n";
        close $wh;
        # Use _exit-style: avoid running END blocks in the child
        # (TestHelper guards against this, but be defensive).
        require POSIX;
        POSIX::_exit(0);
    }

    close $wh;
    chomp(my $child_lock = <$rh>);
    close $rh;
    waitpid $pid, 0;

    is
        $child_lock,
        $parent_lock,
        "forked child inherits the parent's _shm_lock() (captured at module load)";

    cmp_ok $child_lock, '>',  0;
    cmp_ok $child_lock, '<=', 32767;
}

# A second process started fresh (not via fork) generates its own lock
# value based on its own $$. We can verify the formula by simulating
# what such a process would compute.

{
    my $other_pid       = ($$ + 1) % (1 << 16);  # arbitrary different PID
    my $other_lock      = 1 + ($other_pid % 32767);

    cmp_ok $other_lock, '>',  0,     "fresh-process lock is > 0 for an arbitrary PID";
    cmp_ok $other_lock, '<=', 32767, "fresh-process lock is <= 32767 for an arbitrary PID";
}