The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w
use strict;

# avoiding this prologue would be nice, but it seems to be unavoidable,
# see "It is also important to note ..." in perldoc threads
use Config;
my $loaded_threads;
BEGIN {
  if ($Config{useithreads} && $] > 5.008007) {
    $loaded_threads =
      eval {
	require threads;
	threads->import;
	1;
      };
  }
}
use Test::More;

$Config{useithreads}
  or plan skip_all => "can't test Imager's threads support with no threads";
$] > 5.008007
  or plan skip_all => "require a perl with CLONE_SKIP to test Imager's threads support";
$loaded_threads
  or plan skip_all => "couldn't load threads";

$INC{"Devel/Cover.pm"}
  and plan skip_all => "threads and Devel::Cover don't get along";

use Imager;

-d "testout" or mkdir "testout";

Imager->open_log(log => "testout/t080log1.log")
  or plan skip_all => "Cannot open log file: " . Imager->errstr;

plan tests => 3;

Imager->log("main thread a\n");

my $t1 = threads->create
  (
   sub {
     Imager->log("child thread a\n");
     Imager->open_log(log => "testout/t080log2.log")
       or die "Cannot open second log file: ", Imager->errstr;
     Imager->log("child thread b\n");
     sleep(1);
     Imager->log("child thread c\n");
     sleep(1);
     1;
   }
   );

Imager->log("main thread b\n");
sleep(1);
Imager->log("main thread c\n");
ok($t1->join, "join child thread");
Imager->log("main thread d\n");
Imager->close_log();

my %log1 = parse_log("testout/t080log1.log");
my %log2 = parse_log("testout/t080log2.log");

my @log1 =
  (
   "main thread a",
   "main thread b",
   "child thread a",
   "main thread c",
   "main thread d",
  );

my @log2 =
  (
   "child thread b",
   "child thread c",
  );

is_deeply(\%log1, { map {; $_ => 1 } @log1 },
	  "check messages in main thread log");
is_deeply(\%log2, { map {; $_ => 1 } @log2 },
	  "check messages in child thread log");

# grab the messages from the given log
sub parse_log {
  my ($filename) = @_;

  open my $fh, "<", $filename
    or die "Cannot open log file $filename: $!";

  my %lines;
  while (<$fh>) {
    chomp;
    my ($date, $time, $file_line, $level, $message) = split ' ', $_, 5;
    $lines{$message} = 1;
  }

  delete $lines{"Imager - log started (level = 1)"};
  delete $lines{"Imager $Imager::VERSION starting"};

  return %lines;
}

END {
  unlink "testout/t080log1.log", "testout/t080log2.log"
    unless $ENV{IMAGER_KEEP_FILES};
}