This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
4f63c3b141657c1cb588b5b799243378e7a15d53
[perl5.git] / t / run / switchC.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     require "./test.pl";
9
10     skip_all_without_perlio();
11     skip_all_if_miniperl('-C and $ENV{PERL_UNICODE} are disabled on miniperl');
12 }
13
14 plan(tests => 14);
15
16 my $r;
17
18 my $tmpfile = tempfile();
19 my $scriptfile = tempfile();
20
21 my $b = chr 256; utf8::encode $b;
22
23 $r = runperl( switches => [ '-CO', '-w' ],
24               prog     => 'print chr(256)',
25               stderr   => 1 );
26 like( $r, qr/^$b(?:\r?\n)?$/s, '-CO: no warning on UTF-8 output' );
27
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
33 SKIP: {
34     if (exists $ENV{PERL_UNICODE} &&
35         ($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) {
36         skip(qq[cannot test with PERL_UNICODE "" or /[SO]/], 1);
37     }
38     $r = runperl( switches => [ '-CI', '-w' ],
39                   prog     => 'print ord(<STDIN>)',
40                   stderr   => 1,
41                   stdin    => $b );
42     like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' );
43 }
44
45 $r = runperl( switches => [ '-CE', '-w' ],
46               prog     => 'warn chr(256), qq(\n)',
47               stderr   => 1 );
48 like( $r, qr/^$b(?:\r?\n)?$/s, '-CE: UTF-8 stderr' );
49
50 $r = runperl( switches => [ '-Co', '-w' ],
51               prog     => "open(F, q(>$tmpfile)); print F chr(256); close F",
52               stderr   => 1 );
53 like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' );
54
55 $r = runperl( switches => [ '-Ci', '-w' ],
56               prog     => "open(F, q(<$tmpfile)); print ord(<F>); close F",
57               stderr   => 1 );
58 like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' );
59
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
74 $r = runperl( switches => [ '-CA', '-w' ],
75               prog     => 'print ord shift',
76               stderr   => 1,
77               args     => [ chr(256) ] );
78 like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' );
79
80 $r = runperl( switches => [ '-CS', '-w' ],
81               progs    => [ '#!perl -CS', 'print chr(256)'],
82               stderr   => 1, );
83 like( $r, qr/^$b(?:\r?\n)?$/s, '#!perl -C' );
84
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
98 $r = runperl( switches => [ '-CA', '-w' ],
99               progs    => [ '#!perl -CS', 'print chr(256)' ],
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
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 }