| 1 | #!./perl -w
|
|---|
| 2 |
|
|---|
| 3 | # Tests for the command-line switches
|
|---|
| 4 |
|
|---|
| 5 | BEGIN {
|
|---|
| 6 | chdir 't' if -d 't';
|
|---|
| 7 | @INC = '../lib';
|
|---|
| 8 | unless (find PerlIO::Layer 'perlio') {
|
|---|
| 9 | print "1..0 # Skip: not perlio\n";
|
|---|
| 10 | exit 0;
|
|---|
| 11 | }
|
|---|
| 12 | }
|
|---|
| 13 |
|
|---|
| 14 | require "./test.pl";
|
|---|
| 15 |
|
|---|
| 16 | plan(tests => 6);
|
|---|
| 17 |
|
|---|
| 18 | my $r;
|
|---|
| 19 |
|
|---|
| 20 | my @tmpfiles = ();
|
|---|
| 21 | END { unlink @tmpfiles }
|
|---|
| 22 |
|
|---|
| 23 | my $b = pack("C*", unpack("U0C*", pack("U",256)));
|
|---|
| 24 |
|
|---|
| 25 | $r = runperl( switches => [ '-CO', '-w' ],
|
|---|
| 26 | prog => 'print chr(256)',
|
|---|
| 27 | stderr => 1 );
|
|---|
| 28 | like( $r, qr/^$b(?:\r?\n)?$/s, '-CO: no warning on UTF-8 output' );
|
|---|
| 29 |
|
|---|
| 30 | SKIP: {
|
|---|
| 31 | if (exists $ENV{PERL_UNICODE} &&
|
|---|
| 32 | ($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) {
|
|---|
| 33 | skip(qq[cannot test with PERL_UNICODE locale "" or /[SO]/], 1);
|
|---|
| 34 | }
|
|---|
| 35 | $r = runperl( switches => [ '-CI', '-w' ],
|
|---|
| 36 | prog => 'print ord(<STDIN>)',
|
|---|
| 37 | stderr => 1,
|
|---|
| 38 | stdin => $b );
|
|---|
| 39 | like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' );
|
|---|
| 40 | }
|
|---|
| 41 |
|
|---|
| 42 | $r = runperl( switches => [ '-CE', '-w' ],
|
|---|
| 43 | prog => 'warn chr(256), qq(\n)',
|
|---|
| 44 | stderr => 1 );
|
|---|
| 45 | like( $r, qr/^$b(?:\r?\n)?$/s, '-CE: UTF-8 stderr' );
|
|---|
| 46 |
|
|---|
| 47 | $r = runperl( switches => [ '-Co', '-w' ],
|
|---|
| 48 | prog => 'open(F, q(>out)); print F chr(256); close F',
|
|---|
| 49 | stderr => 1 );
|
|---|
| 50 | like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' );
|
|---|
| 51 |
|
|---|
| 52 | push @tmpfiles, "out";
|
|---|
| 53 |
|
|---|
| 54 | $r = runperl( switches => [ '-Ci', '-w' ],
|
|---|
| 55 | prog => 'open(F, q(<out)); print ord(<F>); close F',
|
|---|
| 56 | stderr => 1 );
|
|---|
| 57 | like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' );
|
|---|
| 58 |
|
|---|
| 59 | $r = runperl( switches => [ '-CA', '-w' ],
|
|---|
| 60 | prog => 'print ord shift',
|
|---|
| 61 | stderr => 1,
|
|---|
| 62 | args => [ chr(256) ] );
|
|---|
| 63 | like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' );
|
|---|
| 64 |
|
|---|