Bug in Perl’s Thread::Semaphore: Memory Leak (solution provided)
25 Jan2007

I spent almost all day trying to find and fix really strange bug in one of our server-side applications written on Perl. And as I’ve figured out later, there is huge problem in Perl core libraries or, even, in interpreter.

Problem is following. If you are trying to use “threads” module with “Thread::Semaphore” module like it is mentioned in official Perl documentation (perlthrtut), you’ll get 4kb memory leak on every $semaphore->up call. So, simple test-case like following would cause huge memory leaks (100 Mbytes per second on my test server):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#!/usr/bin/perl

use threads;
use Thread::Semaphore;

my $xxx = new Thread::Semaphore();

my $x = new threads(\&mythread);
$x->join;

sub mythread {
    while (1) {
        $xxx->down();
        $xxx->up();
    }
}

After 5 hours of having sex fun with our project and creating mentioned test-case I’ve decided to go to “official” Perl IRC channel #perl on irc.perl.org. People there was really brutal and did not want to help… Thanks to one guy there, which pointed me to #p5p channel. This channel was almost dead (maybe because of night time in US) but I’ve found great guy there. His name is Sam Vilain. He spent lots of time and found out, that Perl’s bless on shared variables causes strange memory leak (4kb on my server).

Thanks to Sam advices I created simple Thread::Semaphore replacement module which could be used for transparent replacement of original perl core module. So, simply use Sema4; and everything will be fine:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
package Sema4;

use threads::shared;

sub new {
    my $class = shift;
    my $val : shared = @_ ? shift : 1;

    # Workaround because of memory leak
    return bless \\$val, $class;
}

sub down {
    my $s = shift;
    # Double dereferencing
    $s = $$s;
    lock($$s);
    my $inc = @_ ? shift : 1;
    cond_wait $$s until $$s >= $inc;
    $$s -= $inc;
}

sub up {
    my $s = shift;
    # Double dereferencing
    $s = $$s;
    lock($$s);
    my $inc = @_ ? shift : 1;
    ($$s += $inc) > 0 and cond_broadcast $$s;
}

1;

As a bottom line of this story I want to say, that maybe it is time to throw away old “dead” languages which community could not implement normal threads for years and which community does not like to help people with problems with their core modules? I think I definitely should try something else… Don’t know what… maybe Ruby (I don’t like Python’s syntax)? Will see…