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 => 15);
  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 }
 114
 115 $r = runperl ( switches => [ '-C00' ],
 116                prog    => '1',
 117                stderr   => 1, );
 118 like($r, qr/^Invalid number '00' for -C option\.$/s,
 119      "perl -C00 [perl #123991]");