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