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