view release on metacpan or  search on metacpan

t/09_lock.t  view on Meta::CPAN

    # a short while after process 3 (which has no lock at all) sees 19,
    #  sets 20 and requests a read lock (1 will have gotten its write
    #  lock by then)
    while (($myvar = $var) < 19) {usleep(DELTA_T)}
    if ($myvar == 19) {
        usleep(DELTA_T<<2);  # make sure #1 has requested its lock and is waiting
        $var = 20;
        if (!mm_lock($mm, MM_LOCK_RD)) {err 98}
        # when 3 gets its read lock, 1 is still waiting for its write lock,
        #   though there's the theoretical possibility that 1 has gotten
        #   its write lock and then released it
        while (($myvar = $var) < 22) {usleep(DELTA_T)}
        if ($myvar == 22) {
            $var = 23;
            if (!mm_unlock($mm)) {err 93}
        } elsif ($myvar == 24) {
            $var = 25;
            if (!mm_unlock($mm)) {err 93}
    }   }

} else {
    # when process 0 sees 20, it releases its read lock and
    #  advances to 21
    # then it continues to wait until a timeout, or it sees one of
    #  the terminating values
    $var = 18;
    $timer = 0;
    while (($myvar = $var) < 25 && $timer < TIMEOUT) {
        if ($myvar == 20) {
            if (mm_unlock($mm)) {$var = 21}
            else {
                $var = 90;
                usleep(DELTA_T<<4);  # let other activity settle
                $var = $myvar = 90;
                last;
        }   }
        # the while and if comparisons above take a significant number of uS
        #  so if TIMEOUT is to approximate real time, this delay has to be mS
        $timer += DELTA_T;
        usleep(DELTA_T);
    }
    # if timeout, test for other processes still around
    my $st='';
    if ($timer >= TIMEOUT
     && $myvar < 90) {
        for (my $i=1; $i<=3; $i++) {
            if (kill 0, $pid[$i]) {
                $st .= $st ? ", $i" : $i;
    }   }   }

    # create final result message
    my $mes = $myvar==97 ? "id 1 couldn't upgrade read to write lock"
            : $myvar==98 ? "id 3 couldn't get read lock"
            : $myvar>=90 ? "id ".($myvar-90)." couldn't unlock"
            : $myvar< 25 ? "state got stuck at $myvar"
            : "id 1 write lock "
            . ($myvar == 25 ? "was granted before a later id 3 read lock"
                            : "had to wait for a later id 3 read lock");

    # report the test result (2 results are OK)
    ok ($myvar == 25 || $myvar == 26, "$mes: " . ($st ? "process $st still alive" 
                                                      : "timer=$timer of ".TIMEOUT));

    kill 9, $pid[1], $pid[2], $pid[3];
    mm_destroy ($mm);
}
# success on test 11 means that a process can upgrade a read lock
#   to a write lock without first releasing the read lock
#   but online words say this upgrade is subject to an interloper
#   (which is indicated by a 'had to wait for a later' message)