1#!/usr/bin/perl 2########################################################################## 3# The test checks Log::Log4perl::Appender::Synchronized for correct semaphore 4# destruction when using parameter "destroy". 5# Based on: 042SyncApp.t 6# Jens Berthold, 2009 (log4perl@jebecs.de) 7########################################################################## 8use warnings; 9use strict; 10 11BEGIN { 12 if($ENV{INTERNAL_DEBUG}) { 13 require Log::Log4perl::InternalDebug; 14 Log::Log4perl::InternalDebug->enable(); 15 } 16} 17 18use Test::More; 19use Log::Log4perl qw(:easy); 20Log::Log4perl->easy_init($DEBUG); 21use constant INTERNAL_DEBUG => 0; 22 23our $INTERNAL_DEBUG = 0; 24 25$| = 1; 26 27BEGIN { 28 if(exists $ENV{"L4P_ALL_TESTS"}) { 29 plan tests => 1; 30 } else { 31 plan skip_all => "- only with L4P_ALL_TESTS"; 32 } 33} 34 35use Log::Log4perl::Util::Semaphore; 36use Log::Log4perl qw(get_logger); 37use Log::Log4perl::Appender::Synchronized; 38 39my $EG_DIR = "eg"; 40$EG_DIR = "../eg" unless -d $EG_DIR; 41 42my $logfile = "$EG_DIR/fork.log"; 43 44our $lock; 45 46unlink $logfile; 47 48my $conf = qq( 49log4perl.category.Bar.Twix = WARN, Syncer 50 51log4perl.appender.Logfile = Log::Log4perl::Appender::TestFileCreeper 52log4perl.appender.Logfile.autoflush = 1 53log4perl.appender.Logfile.filename = $logfile 54log4perl.appender.Logfile.layout = Log::Log4perl::Layout::PatternLayout 55log4perl.appender.Logfile.layout.ConversionPattern = %F{1}%L> %m%n 56 57log4perl.appender.Syncer = Log::Log4perl::Appender::Synchronized 58log4perl.appender.Syncer.appender = Logfile 59log4perl.appender.Syncer.key = blah 60log4perl.appender.Syncer.destroy = 1 61); 62 63Log::Log4perl::init(\$conf); 64 65my $pid = fork(); 66 67die "fork failed" unless defined $pid; 68 69my $logger = get_logger("Bar::Twix"); 70if($pid) { 71 # parent 72 # no logging test here: if child erroneously deletes semaphore, 73 # any log output at this point would crash the test 74} else { 75 # child 76 exit 0; 77} 78 79# Wait for child to finish 80print "Waiting for pid $pid\n" if $INTERNAL_DEBUG; 81waitpid($pid, 0); 82print "Done waiting for pid $pid\n" if $INTERNAL_DEBUG; 83unlink $logfile; 84 85# Destroying appender (+semaphore) fails if child process already destroyed it 86Log::Log4perl->appender_by_name('Syncer')->DESTROY(); 87ok(!$@, "Destroying appender"); 88 89