use strict;
use warnings;

use threads;
use threads::shared;
use Thread::Semaphore;

use Win32::OLE qw(in);

my $debugSemaphore = Thread::Semaphore->new;

exit !runThreadGroup();;

sub runThreadGroup {

	my %threads : shared; # workaround Win32::OLE + threads bug
	my %exitcodes : shared;
	
	foreach my $i (0..2) {
		my $tid = threads->create(sub {
			debug("Starting thread");
			$exitcodes{threads->tid()} = map {
				debug("-".join(',' , $_->ProcessId, $_->Name));
			} in(Win32::OLE->GetObject("winmgmts:")
				->ExecQuery("SELECT * FROM Win32_Process"));
			delete $threads{threads->tid()};
			debug("Ending thread");
		});
		$threads{$tid->tid()} = undef;
	}

	sleep 1 while keys(%threads) > 0;
	
	print "Thread exit codes: ".join(',', values(%exitcodes))."\n";
	
	foreach my $ec (values(%exitcodes)) {
		return 0 if $ec != 0;
	}
	
	return 1;
}

sub debug {
	my ($message) = @_;
	$debugSemaphore->down;
	print STDERR "# [".threads->tid."] $message\n";
	$debugSemaphore->up;
	return 1;
}

__DATA__
Perl 5.8.8
MSWin32-x86-multi-thread
ActivePerl Build 817

##</code><code>##

...
		my $tid = threads->create(sub {
			require Win32::OLE;
			import Win32::OLE qw(in);
			debug("Starting thread");
			$exitcodes{threads->tid()} = map {
				debug("-".join(',' , $_->ProcessId, $_->Name));
			} in(Win32::OLE->GetObject("winmgmts:")
				->ExecQuery("SELECT * FROM Win32_Process"));
			delete $threads{threads->tid()};
			debug("Ending thread");
			Win32::OLE->Uninitialize();
		});
...