1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!./perl
BEGIN: {
chdir 't' if -d 't';
@INC = ('../lib');
require './test.pl';
}
# supress VMS whinging about bad execs.
use vmsish qw(hushed);
$| = 1; # flush stdout
$ENV{LC_ALL} = 'C'; # Forge English error messages.
$ENV{LANGUAGE} = 'C'; # Ditto in GNU.
my $Is_VMS = $^O eq 'VMS';
my $Is_Win32 = $^O eq 'MSWin32';
skip_all("Tests mostly usesless on MacOS") if $^O eq 'MacOS';
plan(tests => 21);
my $Perl = which_perl();
my $exit;
SKIP: {
skip("bug/feature of pdksh", 2) if $^O eq 'os2';
my $tnum = curr_test();
$exit = system qq{$Perl -le "print q{ok $tnum - interp system(EXPR)"}};
next_test();
is( $exit, 0, ' exited 0' );
}
my $tnum = curr_test();
$exit = system qq{$Perl -le "print q{ok $tnum - split & direct system(EXPR)"}};
next_test();
is( $exit, 0, ' exited 0' );
# On VMS and Win32 you need the quotes around the program or it won't work.
# On Unix its the opposite.
my $quote = $Is_VMS || $Is_Win32 ? '"' : '';
$tnum = curr_test();
$exit = system $Perl, '-le',
"${quote}print q{ok $tnum - system(PROG, LIST)}${quote}";
next_test();
is( $exit, 0, ' exited 0' );
# Some basic piped commands. Some OS's have trouble with "helpfully"
# putting newlines on the end of piped output. So we split this into
# newline insensitive and newline sensitive tests.
my $echo_out = `$Perl -e "print 'ok'" | $Perl -le "print <STDIN>"`;
$echo_out =~ s/\n\n/\n/g;
is( $echo_out, "ok\n", 'piped echo emulation');
{
# here we check if extra newlines are going to be slapped on
# piped output.
local $TODO = 'VMS sticks newlines on everything' if $Is_VMS;
is( scalar `$Perl -e "print 'ok'"`,
"ok", 'no extra newlines on ``' );
is( scalar `$Perl -e "print 'ok'" | $Perl -e "print <STDIN>"`,
"ok", 'no extra newlines on pipes');
is( scalar `$Perl -le "print 'ok'" | $Perl -le "print <STDIN>"`,
"ok\n\n", 'doubled up newlines');
is( scalar `$Perl -e "print 'ok'" | $Perl -le "print <STDIN>"`,
"ok\n", 'extra newlines on inside pipes');
is( scalar `$Perl -le "print 'ok'" | $Perl -e "print <STDIN>"`,
"ok\n", 'extra newlines on outgoing pipes');
{
local($/) = \2;
$out = runperl(prog => 'print q{1234}');
is($out, "1234", 'ignore $/ when capturing output in scalar context');
}
}
is( system(qq{$Perl -e "exit 0"}), 0, 'Explicit exit of 0' );
my $exit_one = $Is_VMS ? 4 << 8 : 1 << 8;
is( system(qq{$Perl "-I../lib" -e "use vmsish qw(hushed); exit 1"}), $exit_one,
'Explicit exit of 1' );
$rc = system { "lskdfj" } "lskdfj";
unless( ok($rc == 255 << 8 or $rc == -1 or $rc == 256 or $rc == 512) ) {
print "# \$rc == $rc\n";
}
unless ( ok( $! == 2 or $! =~ /\bno\b.*\bfile/i or
$! == 13 or $! =~ /permission denied/i or
$! == 22 or $! =~ /invalid argument/ ) ) {
printf "# \$! eq %d, '%s'\n", $!, $!;
}
is( `$Perl -le "print 'ok'"`, "ok\n", 'basic ``' );
is( <<`END`, "ok\n", '<<`HEREDOC`' );
$Perl -le "print 'ok'"
END
TODO: {
my $tnum = curr_test();
if( $^O =~ /Win32/ ) {
print "not ok $tnum - exec failure doesn't terminate process " .
"# TODO Win32 exec failure waits for user input\n";
next_test();
last TODO;
}
ok( !exec("lskdjfalksdjfdjfkls"),
"exec failure doesn't terminate process");
}
my $test = curr_test();
exec $Perl, '-le', qq{${quote}print 'ok $test - exec PROG, LIST'${quote}};
fail("This should never be reached if the exec() worked");
|
