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 }
  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