@@ -, +, @@ --- t/Koha/Script.t | 15 ++++++++++++++- t/Koha/wait.pl | 17 +++++++++++++++++ 2 files changed, 31 insertions(+), 1 deletion(-) create mode 100755 t/Koha/wait.pl --- a/t/Koha/Script.t +++ a/t/Koha/Script.t @@ -48,7 +48,8 @@ my $interface = C4::Context->interface; is( $interface, 'commandline', "Context interface set correctly with no flags" ); subtest 'lock_exec() tests' => sub { - plan tests => 2; + + plan tests => 3; # Launch the sleep script my $pid = fork(); @@ -63,6 +64,18 @@ subtest 'lock_exec() tests' => sub { like( $result, qr{Unable to acquire the lock.*}, 'Exception found' ); + $pid = fork(); + if ( $pid == 0 ) { + system( dirname(__FILE__) . '/sleep.pl 2>&1' ); + exit; + } + + sleep 1; # Make sure we start after the fork + $command = dirname(__FILE__) . '/wait.pl'; + $result = `$command 2>&1`; + + is( $result, 'YAY!', 'wait.pl successfully waits for the lock' ); + throws_ok { Koha::Script->new({ lock_name => 'blah' }); } 'Koha::Exceptions::MissingParameter', --- a/t/Koha/wait.pl +++ a/t/Koha/wait.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl + +use Modern::Perl; + +use Koha::Script; +use Fcntl qw(:flock); +use Try::Tiny; + +# # Lock execution +my $script = Koha::Script->new({ script => 'sleep.pl' }); + +$script->lock_exec({ wait => 1 }); + +print STDOUT "YAY!"; + +# Normal exit +1; --