Commit | Line | Data |
---|---|---|
76dd4efc JH |
1 | #!./perl -w |
2 | ||
3 | # Tests for the command-line switches | |
4 | ||
5 | BEGIN { | |
6 | chdir 't' if -d 't'; | |
7 | @INC = '../lib'; | |
62e452a4 NC |
8 | require "./test.pl"; |
9 | ||
e05e9c3d | 10 | skip_all_without_perlio(); |
62e452a4 | 11 | skip_all_if_miniperl('-C and $ENV{PERL_UNICODE} are disabled on miniperl'); |
76dd4efc JH |
12 | } |
13 | ||
88770b48 | 14 | plan(tests => 13); |
76dd4efc JH |
15 | |
16 | my $r; | |
17 | ||
2d90ac95 | 18 | my $tmpfile = tempfile(); |
88770b48 | 19 | my $scriptfile = tempfile(); |
76dd4efc | 20 | |
a901eef8 JH |
21 | my $b = pack("C*", unpack("U0C*", pack("U",256))); |
22 | ||
76dd4efc JH |
23 | $r = runperl( switches => [ '-CO', '-w' ], |
24 | prog => 'print chr(256)', | |
25 | stderr => 1 ); | |
a901eef8 | 26 | like( $r, qr/^$b(?:\r?\n)?$/s, '-CO: no warning on UTF-8 output' ); |
76dd4efc | 27 | |
06e66572 | 28 | SKIP: { |
81ff9b36 JH |
29 | if (exists $ENV{PERL_UNICODE} && |
30 | ($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) { | |
00c1390f | 31 | skip(qq[cannot test with PERL_UNICODE "" or /[SO]/], 1); |
06e66572 JH |
32 | } |
33 | $r = runperl( switches => [ '-CI', '-w' ], | |
34 | prog => 'print ord(<STDIN>)', | |
35 | stderr => 1, | |
a901eef8 | 36 | stdin => $b ); |
a4c0dc87 | 37 | like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' ); |
06e66572 | 38 | } |
76dd4efc JH |
39 | |
40 | $r = runperl( switches => [ '-CE', '-w' ], | |
41 | prog => 'warn chr(256), qq(\n)', | |
42 | stderr => 1 ); | |
a901eef8 | 43 | like( $r, qr/^$b(?:\r?\n)?$/s, '-CE: UTF-8 stderr' ); |
76dd4efc JH |
44 | |
45 | $r = runperl( switches => [ '-Co', '-w' ], | |
2d90ac95 | 46 | prog => "open(F, q(>$tmpfile)); print F chr(256); close F", |
76dd4efc | 47 | stderr => 1 ); |
a4c0dc87 | 48 | like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' ); |
76dd4efc | 49 | |
76dd4efc | 50 | $r = runperl( switches => [ '-Ci', '-w' ], |
2d90ac95 | 51 | prog => "open(F, q(<$tmpfile)); print ord(<F>); close F", |
76dd4efc | 52 | stderr => 1 ); |
a4c0dc87 | 53 | like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' ); |
76dd4efc | 54 | |
88770b48 NT |
55 | open(S, ">$scriptfile") or die("open $scriptfile: $!"); |
56 | print S "open(F, q(<$tmpfile)); print ord(<F>); close F"; | |
57 | close S; | |
58 | ||
59 | $r = runperl( switches => [ '-Ci', '-w' ], | |
60 | progfile => $scriptfile, | |
61 | stderr => 1 ); | |
62 | like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input affects the current file' ); | |
63 | ||
64 | $r = runperl( switches => [ '-Ci', '-w' ], | |
65 | prog => "do q($scriptfile)", | |
66 | stderr => 1 ); | |
67 | unlike( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input has file scope' ); | |
68 | ||
76dd4efc JH |
69 | $r = runperl( switches => [ '-CA', '-w' ], |
70 | prog => 'print ord shift', | |
71 | stderr => 1, | |
72 | args => [ chr(256) ] ); | |
a4c0dc87 | 73 | like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' ); |
76dd4efc | 74 | |
4ba71d51 | 75 | $r = runperl( switches => [ '-CS', '-w' ], |
ff197582 | 76 | progs => [ '#!perl -CS', 'print chr(256)'], |
4ba71d51 FC |
77 | stderr => 1, ); |
78 | like( $r, qr/^$b(?:\r?\n)?$/s, '#!perl -C' ); | |
74b2b4b1 | 79 | |
d4a59e54 FC |
80 | $r = runperl( switches => [ '-CS' ], |
81 | progs => [ '#!perl -CS -w', 'print chr(256), !!$^W'], | |
82 | stderr => 1, ); | |
83 | like( $r, qr/^${b}1(?:\r?\n)?$/s, '#!perl -C followed by another switch' ); | |
84 | ||
85 | $r = runperl( switches => [ '-CS' ], | |
86 | progs => [ '#!perl -C7 -w', 'print chr(256), !!$^W'], | |
87 | stderr => 1, ); | |
88 | like( | |
89 | $r, qr/^${b}1(?:\r?\n)?$/s, | |
90 | '#!perl -C<num> followed by another switch' | |
91 | ); | |
92 | ||
74b2b4b1 | 93 | $r = runperl( switches => [ '-CA', '-w' ], |
ff197582 | 94 | progs => [ '#!perl -CS', 'print chr(256)' ], |
74b2b4b1 NC |
95 | stderr => 1, ); |
96 | like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s, | |
97 | '#!perl -C with different -C on command line' ); | |
98 | ||
00c1390f RGS |
99 | SKIP: { |
100 | if (exists $ENV{PERL_UNICODE} && $ENV{PERL_UNICODE} =~ /S/) { | |
101 | skip(qq[cannot test with PERL_UNICODE including "S"], 1); | |
102 | } | |
103 | $r = runperl( switches => [ '-w' ], | |
104 | progs => [ '#!perl -CS', 'print chr(256)' ], | |
105 | stderr => 1, ); | |
106 | like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s, | |
107 | '#!perl -C but not command line' ); | |
108 | } |