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 | ||
817e3e2c | 14 | plan(tests => 15); |
76dd4efc JH |
15 | |
16 | my $r; | |
17 | ||
2d90ac95 | 18 | my $tmpfile = tempfile(); |
88770b48 | 19 | my $scriptfile = tempfile(); |
76dd4efc | 20 | |
a12b621d | 21 | my $b = chr 256; utf8::encode $b; |
a901eef8 | 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 | |
89d84ff9 HS |
28 | $r = runperl( switches => [ '-C2', '-w' ], |
29 | prog => 'print chr(256)', | |
30 | stderr => 1 ); | |
31 | like( $r, qr/^$b(?:\r?\n)?$/s, '-C2: no warning on UTF-8 output' ); | |
32 | ||
06e66572 | 33 | SKIP: { |
81ff9b36 JH |
34 | if (exists $ENV{PERL_UNICODE} && |
35 | ($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) { | |
00c1390f | 36 | skip(qq[cannot test with PERL_UNICODE "" or /[SO]/], 1); |
06e66572 JH |
37 | } |
38 | $r = runperl( switches => [ '-CI', '-w' ], | |
39 | prog => 'print ord(<STDIN>)', | |
40 | stderr => 1, | |
a901eef8 | 41 | stdin => $b ); |
a4c0dc87 | 42 | like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' ); |
06e66572 | 43 | } |
76dd4efc JH |
44 | |
45 | $r = runperl( switches => [ '-CE', '-w' ], | |
46 | prog => 'warn chr(256), qq(\n)', | |
47 | stderr => 1 ); | |
a901eef8 | 48 | like( $r, qr/^$b(?:\r?\n)?$/s, '-CE: UTF-8 stderr' ); |
76dd4efc JH |
49 | |
50 | $r = runperl( switches => [ '-Co', '-w' ], | |
2d90ac95 | 51 | prog => "open(F, q(>$tmpfile)); print F chr(256); close F", |
76dd4efc | 52 | stderr => 1 ); |
a4c0dc87 | 53 | like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' ); |
76dd4efc | 54 | |
76dd4efc | 55 | $r = runperl( switches => [ '-Ci', '-w' ], |
2d90ac95 | 56 | prog => "open(F, q(<$tmpfile)); print ord(<F>); close F", |
76dd4efc | 57 | stderr => 1 ); |
a4c0dc87 | 58 | like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' ); |
76dd4efc | 59 | |
88770b48 NT |
60 | open(S, ">$scriptfile") or die("open $scriptfile: $!"); |
61 | print S "open(F, q(<$tmpfile)); print ord(<F>); close F"; | |
62 | close S; | |
63 | ||
64 | $r = runperl( switches => [ '-Ci', '-w' ], | |
65 | progfile => $scriptfile, | |
66 | stderr => 1 ); | |
67 | like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input affects the current file' ); | |
68 | ||
69 | $r = runperl( switches => [ '-Ci', '-w' ], | |
70 | prog => "do q($scriptfile)", | |
71 | stderr => 1 ); | |
72 | unlike( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input has file scope' ); | |
73 | ||
76dd4efc JH |
74 | $r = runperl( switches => [ '-CA', '-w' ], |
75 | prog => 'print ord shift', | |
76 | stderr => 1, | |
77 | args => [ chr(256) ] ); | |
a4c0dc87 | 78 | like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' ); |
76dd4efc | 79 | |
4ba71d51 | 80 | $r = runperl( switches => [ '-CS', '-w' ], |
ff197582 | 81 | progs => [ '#!perl -CS', 'print chr(256)'], |
4ba71d51 FC |
82 | stderr => 1, ); |
83 | like( $r, qr/^$b(?:\r?\n)?$/s, '#!perl -C' ); | |
74b2b4b1 | 84 | |
d4a59e54 FC |
85 | $r = runperl( switches => [ '-CS' ], |
86 | progs => [ '#!perl -CS -w', 'print chr(256), !!$^W'], | |
87 | stderr => 1, ); | |
88 | like( $r, qr/^${b}1(?:\r?\n)?$/s, '#!perl -C followed by another switch' ); | |
89 | ||
90 | $r = runperl( switches => [ '-CS' ], | |
91 | progs => [ '#!perl -C7 -w', 'print chr(256), !!$^W'], | |
92 | stderr => 1, ); | |
93 | like( | |
94 | $r, qr/^${b}1(?:\r?\n)?$/s, | |
95 | '#!perl -C<num> followed by another switch' | |
96 | ); | |
97 | ||
74b2b4b1 | 98 | $r = runperl( switches => [ '-CA', '-w' ], |
ff197582 | 99 | progs => [ '#!perl -CS', 'print chr(256)' ], |
74b2b4b1 NC |
100 | stderr => 1, ); |
101 | like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s, | |
102 | '#!perl -C with different -C on command line' ); | |
103 | ||
00c1390f RGS |
104 | SKIP: { |
105 | if (exists $ENV{PERL_UNICODE} && $ENV{PERL_UNICODE} =~ /S/) { | |
106 | skip(qq[cannot test with PERL_UNICODE including "S"], 1); | |
107 | } | |
108 | $r = runperl( switches => [ '-w' ], | |
109 | progs => [ '#!perl -CS', 'print chr(256)' ], | |
110 | stderr => 1, ); | |
111 | like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s, | |
112 | '#!perl -C but not command line' ); | |
113 | } | |
817e3e2c TC |
114 | |
115 | $r = runperl ( switches => [ '-C00' ], | |
116 | prog => '1', | |
117 | stderr => 1, ); | |
118 | like($r, qr/^Invalid number '00' for -C option\.$/s, | |
119 | "perl -C00 [perl #123991]"); |