Commit | Line | Data |
8a73d5dd |
1 | #!./perl -w |
2 | |
3 | # Tests for the command-line switches |
4 | |
5 | BEGIN { |
6 | chdir 't' if -d 't'; |
7 | @INC = '../lib'; |
8 | } |
9 | |
10 | require "./test.pl"; |
11 | |
77818208 |
12 | plan(tests => 14); |
8a73d5dd |
13 | |
14 | my $r; |
15 | my @tmpfiles = (); |
16 | END { unlink @tmpfiles } |
17 | |
18 | # Tests for -0 |
19 | |
20 | $r = runperl( |
21 | switches => [ '-0', ], |
22 | stdin => 'foo\0bar\0baz\0', |
23 | prog => 'print qq(<$_>) while <>', |
24 | ); |
25 | is( $r, "<foo\0><bar\0><baz\0>", "-0" ); |
26 | |
27 | $r = runperl( |
28 | switches => [ '-l', '-0', '-p' ], |
29 | stdin => 'foo\0bar\0baz\0', |
30 | prog => '1', |
31 | ); |
32 | is( $r, "foo\nbar\nbaz\n", "-0 after a -l" ); |
33 | |
34 | $r = runperl( |
35 | switches => [ '-0', '-l', '-p' ], |
36 | stdin => 'foo\0bar\0baz\0', |
37 | prog => '1', |
38 | ); |
39 | is( $r, "foo\0bar\0baz\0", "-0 before a -l" ); |
40 | |
41 | $r = runperl( |
42 | switches => [ sprintf("-0%o", ord 'x') ], |
43 | stdin => 'fooxbarxbazx', |
44 | prog => 'print qq(<$_>) while <>', |
45 | ); |
46 | is( $r, "<foox><barx><bazx>", "-0 with octal number" ); |
47 | |
48 | $r = runperl( |
49 | switches => [ '-00', '-p' ], |
50 | stdin => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n', |
51 | prog => 's/\n/-/g;$_.=q(/)', |
52 | ); |
53 | is( $r, 'abc-def--/ghi-jkl-mno--/pq-/', '-00 (paragraph mode)' ); |
54 | |
55 | $r = runperl( |
56 | switches => [ '-0777', '-p' ], |
57 | stdin => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n', |
58 | prog => 's/\n/-/g;$_.=q(/)', |
59 | ); |
60 | is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' ); |
61 | |
62 | # Tests for -c |
63 | |
64 | my $filename = 'swctest.tmp'; |
65 | SKIP: { |
66 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); |
67 | print $f <<'SWTEST'; |
68 | BEGIN { print "block 1\n"; } |
69 | CHECK { print "block 2\n"; } |
70 | INIT { print "block 3\n"; } |
71 | print "block 4\n"; |
72 | END { print "block 5\n"; } |
73 | SWTEST |
74 | close $f; |
75 | $r = runperl( |
76 | switches => [ '-c' ], |
77 | progfile => $filename, |
78 | stderr => 1, |
79 | ); |
80 | # Because of the stderr redirection, we can't tell reliably the order |
81 | # in which the output is given |
82 | ok( |
83 | $r =~ /$filename syntax OK/ |
84 | && $r =~ /\bblock 1\b/ |
85 | && $r =~ /\bblock 2\b/ |
86 | && $r !~ /\bblock 3\b/ |
87 | && $r !~ /\bblock 4\b/ |
88 | && $r !~ /\bblock 5\b/, |
89 | '-c' |
90 | ); |
91 | push @tmpfiles, $filename; |
92 | } |
93 | |
94 | # Tests for -l |
95 | |
96 | $r = runperl( |
97 | switches => [ sprintf("-l%o", ord 'x') ], |
98 | prog => 'print for qw/foo bar/' |
99 | ); |
100 | is( $r, 'fooxbarx', '-l with octal number' ); |
101 | |
102 | # Tests for -s |
103 | |
104 | $r = runperl( |
105 | switches => [ '-s' ], |
106 | prog => 'for (qw/abc def ghi/) {print defined $$_ ? $$_ : q(-)}', |
107 | args => [ '--', '-abc=2', '-def', ], |
108 | ); |
109 | is( $r, '21-', '-s switch parsing' ); |
110 | |
111 | # Bug ID 20011106.084 |
112 | $filename = 'swstest.tmp'; |
113 | SKIP: { |
114 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" ); |
115 | print $f <<'SWTEST'; |
116 | #!perl -s |
117 | print $x |
118 | SWTEST |
119 | close $f; |
120 | $r = runperl( |
121 | switches => [ '-s' ], |
122 | progfile => $filename, |
123 | args => [ '-x=foo' ], |
124 | ); |
125 | is( $r, 'foo', '-s on the #! line' ); |
126 | push @tmpfiles, $filename; |
127 | } |
128 | |
129 | # Tests for -m and -M |
130 | |
131 | $filename = 'swtest.pm'; |
132 | SKIP: { |
133 | open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 ); |
134 | print $f <<'SWTESTPM'; |
135 | package swtest; |
136 | sub import { print map "<$_>", @_ } |
137 | 1; |
138 | SWTESTPM |
139 | close $f; |
140 | $r = runperl( |
141 | switches => [ '-Mswtest' ], |
142 | prog => '1', |
143 | ); |
144 | is( $r, '<swtest>', '-M' ); |
145 | $r = runperl( |
146 | switches => [ '-Mswtest=foo' ], |
147 | prog => '1', |
148 | ); |
149 | is( $r, '<swtest><foo>', '-M with import parameter' ); |
150 | $r = runperl( |
151 | switches => [ '-mswtest' ], |
152 | prog => '1', |
153 | ); |
154 | is( $r, '', '-m' ); |
155 | $r = runperl( |
156 | switches => [ '-mswtest=foo,bar' ], |
157 | prog => '1', |
158 | ); |
159 | is( $r, '<swtest><foo><bar>', '-m with import parameters' ); |
160 | push @tmpfiles, $filename; |
161 | } |