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     unless (find PerlIO::Layer 'perlio') {
   9         print "1..0 # Skip: not perlio\n";
  10         exit 0;
  11     }
  12     if ($ENV{PERL_CORE_MINITEST}) {
  13         print "1..0 # Skip : -C and \$ENV{PERL_UNICODE} are disabled on miniperl\n";
  14         exit 0;
  15     }
  16
  17 }
  18
  19 BEGIN { require "./test.pl"; }
  20
  21 plan(tests => 9);
  22
  23 my $r;
  24
  25 my $tmpfile = tempfile();
  26
  27 my $b = pack("C*", unpack("U0C*", pack("U",256)));
  28
  29 $r = runperl( switches => [ '-CO', '-w' ],
  30               prog     => 'print chr(256)',
  31               stderr   => 1 );
  32 like( $r, qr/^$b(?:\r?\n)?$/s, '-CO: no warning on UTF-8 output' );
  33
  34 SKIP: {
  35     if (exists $ENV{PERL_UNICODE} &&
  36         ($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) {
  37         skip(qq[cannot test with PERL_UNICODE locale "" or /[SO]/], 1);
  38     }
  39     $r = runperl( switches => [ '-CI', '-w' ],
  40                   prog     => 'print ord(<STDIN>)',
  41                   stderr   => 1,
  42                   stdin    => $b );
  43     like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' );
  44 }
  45
  46 $r = runperl( switches => [ '-CE', '-w' ],
  47               prog     => 'warn chr(256), qq(\n)',
  48               stderr   => 1 );
  49 like( $r, qr/^$b(?:\r?\n)?$/s, '-CE: UTF-8 stderr' );
  50
  51 $r = runperl( switches => [ '-Co', '-w' ],
  52               prog     => "open(F, q(>$tmpfile)); print F chr(256); close F",
  53               stderr   => 1 );
  54 like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' );
  55
  56 $r = runperl( switches => [ '-Ci', '-w' ],
  57               prog     => "open(F, q(<$tmpfile)); print ord(<F>); close F",
  58               stderr   => 1 );
  59 like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' );
  60
  61 $r = runperl( switches => [ '-CA', '-w' ],
  62               prog     => 'print ord shift',
  63               stderr   => 1,
  64               args     => [ chr(256) ] );
  65 like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' );
  66
  67 $r = runperl( switches => [ '-CS', '-w' ],
  68               progs    => [ '#!perl -CS', 'print chr(256)'],
  69               stderr   => 1, );
  70 like( $r, qr/^$b(?:\r?\n)?$/s, '#!perl -C' );
  71
  72 $r = runperl( switches => [ '-CA', '-w' ],
  73               progs    => [ '#!perl -CS', 'print chr(256)' ],
  74               stderr   => 1, );
  75 like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s,
  76       '#!perl -C with different -C on command line' );
  77
  78 $r = runperl( switches => [ '-w' ],
  79               progs    => [ '#!perl -CS', 'print chr(256)' ],
  80               stderr   => 1, );
  81 like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s,
  82       '#!perl -C but not command line' );