Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
flib	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
cloexec.t	5.73 KB	-r--r--r--	2014-12-27 11:49
dtrace.pl	3 B	-r--r--r--	2014-12-27 11:49
dtrace.t	4.86 KB	-r--r--r--	2014-12-27 11:49
exit.t	5.98 KB	-r--r--r--	2014-12-27 11:49
fresh_perl.t	16.34 KB	-r--r--r--	2014-12-27 11:49
locale.t	9.78 KB	-r--r--r--	2014-12-27 11:49
mad.t	984 B	-r--r--r--	2014-12-27 11:49
noswitch.t	250 B	-r--r--r--	2014-12-27 11:49
runenv.t	9.15 KB	-r--r--r--	2014-12-27 11:49
script.t	578 B	-r--r--r--	2014-12-27 11:49
switch0.t	154 B	-r--r--r--	2014-12-27 11:49
switchC.t	3.4 KB	-r--r--r--	2014-12-27 11:49
switchF.t	223 B	-r--r--r--	2014-12-27 11:49
switchF1.t	915 B	-r--r--r--	2014-12-27 11:49
switchF2.t	499 B	-r--r--r--	2014-12-27 11:49
switchI.t	849 B	-r--r--r--	2014-12-27 11:49
switchM.t	1.03 KB	-r--r--r--	2014-12-27 11:49
switcha.t	218 B	-r--r--r--	2014-12-27 11:49
switchd-78586.t	644 B	-r--r--r--	2014-12-27 11:49
switchd.t	6.93 KB	-r--r--r--	2014-12-27 11:49
switches.t	11.83 KB	-r--r--r--	2014-12-27 11:49
switchn.t	246 B	-r--r--r--	2014-12-27 11:49
switchp.t	314 B	-r--r--r--	2014-12-27 11:49
switcht.t	1.61 KB	-r--r--r--	2014-12-27 11:49
switchx.aux	396 B	-r--r--r--	2014-12-27 11:49
switchx.t	1.04 KB	-r--r--r--	2014-12-27 11:49
switchx2.aux	503 B	-r--r--r--	2014-12-27 11:49
switchx3.aux	50 B	-r--r--r--	2014-12-27 11:49

Rename

#!./perl -w

# Tests for the command-line switches

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
    require "./test.pl";

skip_all_without_perlio();
    skip_all_if_miniperl('-C and $ENV{PERL_UNICODE} are disabled on miniperl');
}

plan(tests => 13);

my $r;

my $tmpfile = tempfile();
my $scriptfile = tempfile();

my $b = pack("C*", unpack("U0C*", pack("U",256)));

$r = runperl( switches => [ '-CO', '-w' ],
	      prog     => 'print chr(256)',
              stderr   => 1 );
like( $r, qr/^$b(?:\r?\n)?$/s, '-CO: no warning on UTF-8 output' );

SKIP: {
    if (exists $ENV{PERL_UNICODE} &&
	($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) {
	skip(qq[cannot test with PERL_UNICODE "" or /[SO]/], 1);
    }
    $r = runperl( switches => [ '-CI', '-w' ],
		  prog     => 'print ord(<STDIN>)',
		  stderr   => 1,
		  stdin    => $b );
    like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' );
}

$r = runperl( switches => [ '-CE', '-w' ],
	      prog     => 'warn chr(256), qq(\n)',
              stderr   => 1 );
like( $r, qr/^$b(?:\r?\n)?$/s, '-CE: UTF-8 stderr' );

$r = runperl( switches => [ '-Co', '-w' ],
	      prog     => "open(F, q(>$tmpfile)); print F chr(256); close F",
              stderr   => 1 );
like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' );

$r = runperl( switches => [ '-Ci', '-w' ],
	      prog     => "open(F, q(<$tmpfile)); print ord(<F>); close F",
              stderr   => 1 );
like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' );

open(S, ">$scriptfile") or die("open $scriptfile: $!");
print S "open(F, q(<$tmpfile)); print ord(<F>); close F";
close S;

$r = runperl( switches => [ '-Ci', '-w' ],
	      progfile => $scriptfile,
              stderr   => 1 );
like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input affects the current file' );

$r = runperl( switches => [ '-Ci', '-w' ],
	      prog     => "do q($scriptfile)",
              stderr   => 1 );
unlike( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input has file scope' );

$r = runperl( switches => [ '-CA', '-w' ],
	      prog     => 'print ord shift',
              stderr   => 1,
              args     => [ chr(256) ] );
like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' );

$r = runperl( switches => [ '-CS', '-w' ],
	      progs    => [ '#!perl -CS', 'print chr(256)'],
              stderr   => 1, );
like( $r, qr/^$b(?:\r?\n)?$/s, '#!perl -C' );

$r = runperl( switches => [ '-CS' ],
	      progs    => [ '#!perl -CS -w', 'print chr(256), !!$^W'],
              stderr   => 1, );
like( $r, qr/^${b}1(?:\r?\n)?$/s, '#!perl -C followed by another switch' );

$r = runperl( switches => [ '-CS' ],
	      progs    => [ '#!perl -C7 -w', 'print chr(256), !!$^W'],
              stderr   => 1, );
like(
  $r, qr/^${b}1(?:\r?\n)?$/s,
 '#!perl -C<num> followed by another switch'
);

$r = runperl( switches => [ '-CA', '-w' ],
	      progs    => [ '#!perl -CS', 'print chr(256)' ],
              stderr   => 1, );
like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s,
      '#!perl -C with different -C on command line' );

SKIP: {
    if (exists $ENV{PERL_UNICODE} && $ENV{PERL_UNICODE} =~ /S/) {
	skip(qq[cannot test with PERL_UNICODE including "S"], 1);
    }
    $r = runperl( switches => [ '-w' ],
                  progs    => [ '#!perl -CS', 'print chr(256)' ],
                  stderr   => 1, );
    like( $r, qr/^Too late for "-CS" option at -e line 1\.$/s,
          '#!perl -C but not command line' );
}