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