1#!./perl -w
2
3# Tests for the command-line switches
4
5BEGIN {
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
14plan(tests => 15);
15
16my $r;
17
18my $tmpfile = tempfile();
19my $scriptfile = tempfile();
20
21my $b = chr 256; utf8::encode $b;
22
23$r = runperl( switches => [ '-CO', '-w' ],
24	      prog     => 'print chr(256)',
25              stderr   => 1 );
26like( $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 );
31like( $r, qr/^$b(?:\r?\n)?$/s, '-C2: no warning on UTF-8 output' );
32
33SKIP: {
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 );
48like( $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 );
53like( $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 );
58like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' );
59
60open(S, ">$scriptfile") or die("open $scriptfile: $!");
61print S "open(F, q(<$tmpfile)); print ord(<F>); close F";
62close S;
63
64$r = runperl( switches => [ '-Ci', '-w' ],
65	      progfile => $scriptfile,
66              stderr   => 1 );
67like( $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 );
72unlike( $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) ] );
78like( $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, );
83like( $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, );
88like( $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, );
93like(
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, );
101like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s,
102      '#!perl -C with different -C on command line' );
103
104SKIP: {
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}
114
115$r = runperl ( switches => [ '-C00' ],
116               prog    => '1',
117               stderr   => 1, );
118like($r, qr/^Invalid number '00' for -C option\.$/s,
119     "perl -C00 [perl #123991]");
120