BEGIN {
if
(
$ENV
{PERL_CORE}) {
chdir
't'
if
-d
't'
;
@INC
=
'../lib'
;
}
}
sub
slurp ($) {
open
(
my
$handle
,
$_
[0] );
local
$/; <
$handle
> }
ok(
open
(
my
$handle
,
'>script'
),
"Create script #1: $!"
);
ok(
print
(
$handle
<<'EOD' ),"Print script #1: $!" );
$| = 1;
use Sys::RunAlone @ARGV;
<>;
EOD
ok(
close
(
$handle
),
"Close script #1: $!"
);
my
$ok
;
my
$command
;
foreach
(
""
,
"'silent'"
) {
my
$ok
= 0;
my
$command
=
"| $^X -I$INC[-1] script $_ 2>2"
;
$ok
++
if
ok(
open
(
my
$stdin
,
$command
),
"Run script #1: $!"
);
sleep
2;
chomp
(
my
$error
= slurp 2 );
$ok
++
if
is(
$error
,
"Add __END__ to end of script 'script' to be able use the features of Sys::RunALone"
,
"Error message #1"
);
$ok
++
if
ok( !
close
(
$stdin
),
"Close pipe #1: $!"
);
diag(
$command
)
if
$ok
!= 3;
}
ok(
open
(
$handle
,
'>script'
),
"Create script #2: $!"
);
ok(
print
(
$handle
<<'EOD' ),"Print script #2: $!" );
$| = 1;
use Sys::RunAlone @ARGV;
<>;
__END__
EOD
ok(
close
(
$handle
),
"Close script #2: $!"
);
$ok
= 0;
$command
=
"| $^X -I$INC[-1] script 2>2"
;
$ok
++
if
ok(
open
(
my
$stdin1
,
$command
),
"Run script #2: $!"
);
sleep
2;
chomp
(
my
$error1
= slurp 2 );
$ok
++
if
is(
$error1
,
""
,
"Error message #2"
);
diag(
$command
)
if
$ok
!= 2;
$ok
= 0;
$ok
++
if
ok(
open
(
my
$stdin2
,
$command
),
"Run script #2 again: $!"
);
sleep
2;
chomp
(
my
$error2
= slurp 2 );
$ok
++
if
is(
$error2
,
"A copy of 'script' is already running"
,
"Error message #2a"
);
$ok
++
if
ok( !
close
(
$stdin2
),
"Close pipe #2a: $!"
);
diag(
$command
)
if
$ok
!= 3;
$ok
= 0;
$command
=
"| $^X -I$INC[-1] script 'silent' 2>2"
;
$ok
++
if
ok(
open
(
my
$stdin2a
,
$command
),
"Run script #2 again: $!"
);
sleep
2;
chomp
(
my
$error2a
= slurp 2 );
$ok
++
if
is(
$error2a
,
""
,
"Error message #2aa"
);
$ok
++
if
ok( !
close
(
$stdin2a
),
"Close pipe #2aa: $!"
);
diag(
$command
)
if
$ok
!= 3;
$ok
= 0;
$command
=
"| SKIP_SYS_RUNALONE=0 $^X -I$INC[-1] script 2>2"
;
$ok
++
if
ok(
open
(
my
$stdin3
,
$command
),
"Run script #2 once more: $!"
);
sleep
2;
chomp
(
my
$error3
= slurp 2 );
$ok
++
if
is(
$error3
,
"A copy of 'script' is already running"
,
"Error message #2a"
);
$ok
++
if
ok( !
close
(
$stdin3
),
"Close pipe #2b: $!"
);
diag(
$command
)
if
$ok
!= 3;
$ok
= 0;
$command
=
"| SKIP_SYS_RUNALONE=1 $^X -I$INC[-1] script 2>2"
;
$ok
++
if
ok(
open
(
my
$stdin4
,
$command
),
"Run script #2 with SKIP=1: $!"
);
$ok
++
if
ok(
print
(
$stdin4
$/ ),
"Print pipe #2c: $!"
);
sleep
2;
chomp
(
my
$error4
= slurp 2 );
$ok
++
if
is(
$error4
,
""
);
TODO: {
local
$TODO
=
"seem to get timeout most of the time, why?"
;
$ok
++; ok( !
close
(
$stdin4
),
"Close pipe #2c: $!"
);
};
diag(
$command
)
if
$ok
!= 4;
$ok
= 0;
$command
=
"| SKIP_SYS_RUNALONE=2 $^X -I$INC[-1] script 2>2"
;
$ok
++
if
ok(
open
(
my
$stdin5
,
$command
),
"Run script #2 with SKIP=2: $!"
);
$ok
++
if
ok(
print
(
$stdin5
$/ ),
"Print pipe #2d: $!"
);
sleep
2;
chomp
(
my
$error5
= slurp 2 );
$ok
++
if
is(
$error5
,
"Skipping Sys::RunAlone check for 'script'"
);
TODO: {
local
$TODO
=
"seem to get timeout most of the time, why?"
;
$ok
++; ok( !
close
(
$stdin5
),
"Close pipe #2d: $!"
);
};
diag(
$command
)
if
$ok
!= 4;
ok(
print
(
$stdin1
$/ ),
"Print pipe #2: $!"
);
ok(
close
(
$stdin1
),
"Close pipe #2: $!"
);
is( 2,
unlink
(
qw(script 2)
),
"Cleanup"
);
1
while
unlink
qw(script 2)
;