Added optional char limit to _num_to_alpha() in test.pl

[perl5.git] / t / run / switchC.t

diff --git a/t/run/switchC.t b/t/run/switchC.t
index 213bdbc..b1a243c 100644 (file)
--- a/t/run/switchC.t
+++ b/t/run/switchC.t
@@ -5,24 +5,18 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    unless (find PerlIO::Layer 'perlio') {
-       print "1..0 # Skip: not perlio\n";
-       exit 0;
-    }
-    if ($ENV{PERL_CORE_MINITEST}) {
-       print "1..0 # Skip : -C and \$ENV{PERL_UNICODE} are disabled on miniperl\n";
-       exit 0;
-    }
-       
-}
+    require "./test.pl";
 
-BEGIN { require "./test.pl"; }
+    skip_all_without_perlio();
+    skip_all_if_miniperl('-C and $ENV{PERL_UNICODE} are disabled on miniperl');
+}
 
-plan(tests => 9);
+plan(tests => 13);
 
 my $r;
 
 my $tmpfile = tempfile();
+my $scriptfile = tempfile();
 
 my $b = pack("C*", unpack("U0C*", pack("U",256)));
 
@@ -34,7 +28,7 @@ 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 locale "" or /[SO]/], 1);
+       skip(qq[cannot test with PERL_UNICODE "" or /[SO]/], 1);
     }
     $r = runperl( switches => [ '-CI', '-w' ],
                  prog     => 'print ord(<STDIN>)',
@@ -58,6 +52,20 @@ $r = runperl( switches => [ '-Ci', '-w' ],
               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,
@@ -69,14 +77,32 @@ $r = runperl( switches => [ '-CS', '-w' ],
               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' );
 
-$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' );
+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' );
+}