develooper Front page | perl.perl5.porters | Postings from August 2001

[ID 20010821.005] Thread safe queues on SMP kernel

Thread Next
From:
David Redmond
Date:
August 21, 2001 15:13
Subject:
[ID 20010821.005] Thread safe queues on SMP kernel
Message ID:
200108212212.f7LMCaM19484@noordwijk.scm.na.mscsoftware.com

This is a bug report for perl from david.redmond@mscsoftware.com,
generated with the help of perlbug 1.33 running under perl v5.6.1.


-----------------------------------------------------------------
The following source reveals bugs in Thread::Queue consistant with a race condition. This bug is similar to ID 19991203.003 <http://archive.develooper.com/perl5-porters%40perl.org/msg04442.html>. The test performed by ext/Thread/queue.t does not pick it up.

Sample output from linux 2.4.3 SMP system:
97 34 30 40 18 1 37 89 23 75 60 44 78 11 65 80 66 19 28 71 55 Attempt to free unreferenced scalar at ./example line 37 thread 1.
43 29 11 84 11 66 31 71 33 2 83 45 94 93 10 60 8 10 41 32 11 5 53 58 31 6 93 29 81 31 85 96 37 59 14 26 26 52 67 54 34 81 90 Attempt to free unreferenced scalar at ./example line 53 thread 2.
Segmentation fault

================================================
example.pl source code:

#!/usr/bin/perl 

use Thread;
use Thread::Queue;

$que;

$q1 = Thread::Queue->new();
$q2 = Thread::Queue->new();
$q3 = Thread::Queue->new();

Thread->new(\&one);
Thread->new(\&two);
Thread->new(\&three);

for (my $i = 1; $i <= 100; $i++) {
  my $el = int(rand(100));
  if (1) {
    lock($que);
    $q1->enqueue($el);
  }
  select(undef,undef,undef,rand(0.5));
}

if (1) {
  lock($que);
  $q1->enqueue(-1);
}

sub one {
  my ($el);
  while (1) {
    if (1) {
      lock($que);
      $el = $q1->dequeue_nb;
    }
    next unless defined($el);
    if (1) {
      lock($que);
      $q2->enqueue($el);
      last if $el == -1;
    }
  }
}

sub two {
  my ($el);
  while (1) {
    if (1) {
      lock($que);
      $el = $q2->dequeue_nb;
    }
    next unless defined($el);
    if (1) {
      lock($que);
      $q3->enqueue($el);
      last if $el == -1;
    }
  }
}

sub three {
  my ($el);
  while (1) {
    if (1) {
      lock($que);
      $el = $q3->dequeue_nb;
    }
    next unless defined($el);
    $| = 1;
    print "$el ";
    $| = 0;
    last if $el == -1;
  }
}

===============================
End of example.pl

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=high
---
Site configuration information for perl v5.6.1:

Configured by root at Tue Aug 21 14:09:27 PDT 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
  Platform:
    osname=linux, osvers=2.4.3-1.msc-smp, archname=i686-linux-thread
    uname='linux noordwijk 2.4.3-1.msc-smp #1 smp mon jul 23 13:52:18 pdt 2001 i686 unknown '
    config_args='-des -DDEBUGGING -Dprefix=/usr -Dusethreads -Duse5005threads'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define use5005threads=define useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.3 20010315 (release)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -ldb -ldl -lm -lpthread -lc -lposix -lcrypt -lutil
    perllibs=-lnsl -ldl -lm -lpthread -lc -lposix -lcrypt -lutil
    libc=/lib/libc-2.1.3.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    

---
@INC for perl v5.6.1:
    /usr/lib/perl5/5.6.1/i686-linux-thread
    /usr/lib/perl5/5.6.1
    /usr/lib/perl5/site_perl/5.6.1/i686-linux-thread
    /usr/lib/perl5/site_perl/5.6.1
    /usr/lib/perl5/site_perl
    .

---
Environment for perl v5.6.1:
    HOME=/noordwijk/users/redmond
    LANG=C
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/bin:/usr/bin:/usr/local/sbin/:/usr/local/bin/
    PERL_BADLANG (unset)
    SHELL=/bin/bash


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About