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