This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Smoke 18027 FAIL(F) MSWin32 5.0 Win2000Pro (MSWin32-x86)
[perl5.git] / t / run / switches.t
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
12 plan(tests => 20);
13
14 # due to a bug in VMS's piping which makes it impossible for runperl()
15 # to emulate echo -n (ie. stdin always winds up with a newline), these 
16 # tests almost totally fail.
17 $TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS';
18
19 my $r;
20 my @tmpfiles = ();
21 END { unlink @tmpfiles }
22
23 # Tests for -0
24
25 $r = runperl(
26     switches    => [ '-0', ],
27     stdin       => 'foo\0bar\0baz\0',
28     prog        => 'print qq(<$_>) while <>',
29 );
30 is( $r, "<foo\0><bar\0><baz\0>", "-0" );
31
32 $r = runperl(
33     switches    => [ '-l', '-0', '-p' ],
34     stdin       => 'foo\0bar\0baz\0',
35     prog        => '1',
36 );
37 is( $r, "foo\nbar\nbaz\n", "-0 after a -l" );
38
39 $r = runperl(
40     switches    => [ '-0', '-l', '-p' ],
41     stdin       => 'foo\0bar\0baz\0',
42     prog        => '1',
43 );
44 is( $r, "foo\0bar\0baz\0", "-0 before a -l" );
45
46 $r = runperl(
47     switches    => [ sprintf("-0%o", ord 'x') ],
48     stdin       => 'fooxbarxbazx',
49     prog        => 'print qq(<$_>) while <>',
50 );
51 is( $r, "<foox><barx><bazx>", "-0 with octal number" );
52
53 $r = runperl(
54     switches    => [ '-00', '-p' ],
55     stdin       => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
56     prog        => 's/\n/-/g;$_.=q(/)',
57 );
58 is( $r, 'abc-def--/ghi-jkl-mno--/pq-/', '-00 (paragraph mode)' );
59
60 $r = runperl(
61     switches    => [ '-0777', '-p' ],
62     stdin       => 'abc\ndef\n\nghi\njkl\nmno\n\npq\n',
63     prog        => 's/\n/-/g;$_.=q(/)',
64 );
65 is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' );
66
67 $r = runperl(
68     switches    => [ '-066' ],
69     prog        => 'BEGIN { print qq{($/)} } print qq{[$/]}',
70 );
71 is( $r, "(\066)[\066]", '$/ set at compile-time' );
72
73 # Tests for -c
74
75 my $filename = 'swctest.tmp';
76 SKIP: {
77     local $TODO = '';   # this one works on VMS
78
79     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
80     print $f <<'SWTEST';
81 BEGIN { print "block 1\n"; }
82 CHECK { print "block 2\n"; }
83 INIT  { print "block 3\n"; }
84         print "block 4\n";
85 END   { print "block 5\n"; }
86 SWTEST
87     close $f or die "Could not close: $!";
88     $r = runperl(
89         switches        => [ '-c' ],
90         progfile        => $filename,
91         stderr          => 1,
92     );
93     # Because of the stderr redirection, we can't tell reliably the order
94     # in which the output is given
95     ok(
96         $r =~ /$filename syntax OK/
97         && $r =~ /\bblock 1\b/
98         && $r =~ /\bblock 2\b/
99         && $r !~ /\bblock 3\b/
100         && $r !~ /\bblock 4\b/
101         && $r !~ /\bblock 5\b/,
102         '-c'
103     );
104     push @tmpfiles, $filename;
105 }
106
107 # Tests for -l
108
109 $r = runperl(
110     switches    => [ sprintf("-l%o", ord 'x') ],
111     prog        => 'print for qw/foo bar/'
112 );
113 is( $r, 'fooxbarx', '-l with octal number' );
114
115 # Tests for -s
116
117 $r = runperl(
118     switches    => [ '-s' ],
119     prog        => 'for (qw/abc def ghi/) {print defined $$_ ? $$_ : q(-)}',
120     args        => [ '--', '-abc=2', '-def', ],
121 );
122 is( $r, '21-', '-s switch parsing' );
123
124 # Bug ID 20011106.084
125 $filename = 'swstest.tmp';
126 SKIP: {
127     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
128     print $f <<'SWTEST';
129 #!perl -s
130 print $x
131 SWTEST
132     close $f or die "Could not close: $!";
133     $r = runperl(
134         switches    => [ '-s' ],
135         progfile    => $filename,
136         args        => [ '-x=foo' ],
137     );
138     is( $r, 'foo', '-s on the shebang line' );
139     push @tmpfiles, $filename;
140 }
141
142 # Tests for -m and -M
143
144 $filename = 'swtest.pm';
145 SKIP: {
146     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 );
147     print $f <<'SWTESTPM';
148 package swtest;
149 sub import { print map "<$_>", @_ }
150 1;
151 SWTESTPM
152     close $f or die "Could not close: $!";
153     $r = runperl(
154         switches    => [ '-Mswtest' ],
155         prog        => '1',
156     );
157     is( $r, '<swtest>', '-M' );
158     $r = runperl(
159         switches    => [ '-Mswtest=foo' ],
160         prog        => '1',
161     );
162     is( $r, '<swtest><foo>', '-M with import parameter' );
163     $r = runperl(
164         switches    => [ '-mswtest' ],
165         prog        => '1',
166     );
167
168     {
169         local $TODO = '';  # this one works on VMS
170         is( $r, '', '-m' );
171     }
172     $r = runperl(
173         switches    => [ '-mswtest=foo,bar' ],
174         prog        => '1',
175     );
176     is( $r, '<swtest><foo><bar>', '-m with import parameters' );
177     push @tmpfiles, $filename;
178 }
179
180 # Tests for -V
181
182 {
183     local $TODO = '';   # these ones should work on VMS
184
185     # basic perl -V should generate significant output.
186     # we don't test actual format since it could change
187     like( runperl( switches => ['-V'] ), qr/(\n.*){20}/,
188           '-V generates 20+ lines' );
189
190     # lookup a known config var
191     chomp( $r=runperl( switches => ['-V:osname'] ) );
192     is( $r, "osname='$^O';", 'perl -V:osname');
193
194     # lookup a nonexistent var
195     chomp( $r=runperl( switches => ['-V:this_var_makes_switches_test_fail'] ) );
196     is( $r, "this_var_makes_switches_test_fail='UNKNOWN';",
197         'perl -V:unknown var');
198
199     # regexp lookup
200     # platforms that don't like this quoting can either skip this test
201     # or fix test.pl _quote_args
202     $r = runperl( switches => ['"-V:i\D+size"'] );
203     # should be unlike( $r, qr/^$|not found|UNKNOWN/ );
204     like( $r, qr/^(?!.*(not found|UNKNOWN))./, 'perl -V:re got a result' );
205
206     # make sure each line we got matches the re
207     ok( !( grep !/^i\D+size=/, split /^/, $r ), '-V:re correct' );
208 }