t/850-thread/110-log.t

   1 #!perl -w
   2 use strict;
   3
   4 # avoiding this prologue would be nice, but it seems to be unavoidable,
   5 # see "It is also important to note ..." in perldoc threads
   6 use Config;
   7 my $loaded_threads;
   8 BEGIN {
   9   if ($Config{useithreads} && $] > 5.008007) {
  10     $loaded_threads =
  11       eval {
  12         require threads;
  13         threads->import;
  14         1;
  15       };
  16   }
  17 }
  18 use Test::More;
  19
  20 $Config{useithreads}
  21   or plan skip_all => "can't test Imager's threads support with no threads";
  22 $] > 5.008007
  23   or plan skip_all => "require a perl with CLONE_SKIP to test Imager's threads support";
  24 $loaded_threads
  25   or plan skip_all => "couldn't load threads";
  26
  27 $INC{"Devel/Cover.pm"}
  28   and plan skip_all => "threads and Devel::Cover don't get along";
  29
  30 use Imager;
  31
  32 -d "testout" or mkdir "testout";
  33
  34 Imager->open_log(log => "testout/t080log1.log")
  35   or plan skip_all => "Cannot open log file: " . Imager->errstr;
  36
  37 plan tests => 3;
  38
  39 Imager->log("main thread a\n");
  40
  41 my $t1 = threads->create
  42   (
  43    sub {
  44      Imager->log("child thread a\n");
  45      Imager->open_log(log => "testout/t080log2.log")
  46        or die "Cannot open second log file: ", Imager->errstr;
  47      Imager->log("child thread b\n");
  48      sleep(1);
  49      Imager->log("child thread c\n");
  50      sleep(1);
  51      1;
  52    }
  53    );
  54
  55 Imager->log("main thread b\n");
  56 sleep(1);
  57 Imager->log("main thread c\n");
  58 ok($t1->join, "join child thread");
  59 Imager->log("main thread d\n");
  60 Imager->close_log();
  61
  62 my %log1 = parse_log("testout/t080log1.log");
  63 my %log2 = parse_log("testout/t080log2.log");
  64
  65 my @log1 =
  66   (
  67    "main thread a",
  68    "main thread b",
  69    "child thread a",
  70    "main thread c",
  71    "main thread d",
  72   );
  73
  74 my @log2 =
  75   (
  76    "child thread b",
  77    "child thread c",
  78   );
  79
  80 is_deeply(\%log1, { map {; $_ => 1 } @log1 },
  81           "check messages in main thread log");
  82 is_deeply(\%log2, { map {; $_ => 1 } @log2 },
  83           "check messages in child thread log");
  84
  85 # grab the messages from the given log
  86 sub parse_log {
  87   my ($filename) = @_;
  88
  89   open my $fh, "<", $filename
  90     or die "Cannot open log file $filename: $!";
  91
  92   my %lines;
  93   while (<$fh>) {
  94     chomp;
  95     my ($date, $time, $file_line, $level, $message) = split ' ', $_, 5;
  96     $lines{$message} = 1;
  97   }
  98
  99   delete $lines{"Imager - log started (level = 1)"};
 100   delete $lines{"Imager $Imager::VERSION starting"};
 101
 102   return %lines;
 103 }
 104
 105 END {
 106   unlink "testout/t080log1.log", "testout/t080log2.log"
 107     unless $ENV{IMAGER_KEEP_FILES};
 108 }