Remove support for assertions and -A

[p5sagit/p5-mst-13.2.git] / t / io / layers.t

diff --git a/t/io/layers.t b/t/io/layers.t
index 1596d72..c399b2a 100644 (file)
--- a/t/io/layers.t
+++ b/t/io/layers.t
@@ -1,36 +1,128 @@
 #!./perl
 
+my $PERLIO;
+
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
+    unless (find PerlIO::Layer 'perlio') {
+       print "1..0 # Skip: not perlio\n";
+       exit 0;
+    }
+    eval 'use Encode';
+    if ($@ =~ /dynamic loading not available/) {
+        print "1..0 # miniperl cannot load Encode\n";
+       exit 0;
+    }
+    # Makes testing easier.
+    $ENV{PERLIO} = 'stdio' if exists $ENV{PERLIO} && $ENV{PERLIO} eq '';
+    if (exists $ENV{PERLIO} && $ENV{PERLIO} !~ /^(stdio|perlio|mmap)$/) {
+       # We are not prepared for anything else.
+       print "1..0 # PERLIO='$ENV{PERLIO}' unknown\n";
+       exit 0;
+    }
+    $PERLIO = exists $ENV{PERLIO} ? $ENV{PERLIO} : "(undef)";
 }
 
-plan tests => 43;
-
 use Config;
 
-{
-    skip("This perl does not have perlio and Encode", 43)
-       unless $Config{useperlio} && " $Config{extensions} " =~ / Encode /;
+my $DOSISH    = $^O =~ /^(?:MSWin32|os2|dos|NetWare|mint)$/ ? 1 : 0;
+   $DOSISH    = 1 if !$DOSISH and $^O =~ /^uwin/;
+my $NONSTDIO  = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio'     ? 1 : 0;
+my $FASTSTDIO = $Config{d_faststdio} && $Config{usefaststdio}      ? 1 : 0;
+my $UTF8_STDIN;
+if (${^UNICODE} & 1) {
+    if (${^UNICODE} & 64) {
+       # Conditional on the locale
+       $UTF8_STDIN = ${^UTF8LOCALE};
+    } else {
+       # Unconditional
+       $UTF8_STDIN = 1;
+    }
+} else {
+    $UTF8_STDIN = 0;
+}
+my $NTEST = 44 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0)
+    + $UTF8_STDIN;
+
+sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h
+
+plan tests => $NTEST;
+
+print <<__EOH__;
+# PERLIO        = $PERLIO
+# DOSISH        = $DOSISH
+# NONSTDIO      = $NONSTDIO
+# FASTSTDIO     = $FASTSTDIO
+# UNICODE       = ${^UNICODE}
+# UTF8LOCALE    = ${^UTF8LOCALE}
+# UTF8_STDIN = $UTF8_STDIN
+__EOH__
+
+SKIP: {
+    # FIXME - more of these could be tested without Encode or full perl
+    skip("This perl does not have Encode", $NTEST)
+       unless " $Config{extensions} " =~ / Encode /;
+    skip("miniperl does not have Encode", $NTEST) if $ENV{PERL_CORE_MINITEST};
 
     sub check {
        my ($result, $expected, $id) = @_;
+       # An interesting dance follows where we try to make the following
+       # IO layer stack setups to compare equal:
+       #
+       # PERLIO     UNIX-like                   DOS-like
+       #
+       # unset / "" unix perlio / stdio [1]     unix crlf
+       # stdio      unix perlio / stdio [1]     stdio
+       # perlio     unix perlio                 unix perlio
+       # mmap       unix mmap                   unix mmap
+       #
+       # [1] "stdio" if Configure found out how to do "fast stdio" (depends
+       # on the stdio implementation) and in Perl 5.8, otherwise "unix perlio"
+       #
+       if ($NONSTDIO) {
+           # Get rid of "unix".
+           shift @$result if $result->[0] eq "unix";
+           # Change expectations.
+           if ($FASTSTDIO) {
+               $expected->[0] = $ENV{PERLIO};
+           } else {
+               $expected->[0] = $ENV{PERLIO} if $expected->[0] eq "stdio";
+           }
+       } elsif (!$FASTSTDIO && !$DOSISH) {
+           splice(@$result, 0, 2, "stdio")
+               if @$result >= 2 &&
+                  $result->[0] eq "unix" &&
+                  $result->[1] eq "perlio";
+       } elsif ($DOSISH) {
+           splice(@$result, 0, 2, "stdio")
+               if @$result >= 2 &&
+                  $result->[0] eq "unix" &&
+                  $result->[1] eq "crlf";
+       }
+       if ($DOSISH && grep { $_ eq 'crlf' } @$expected) {
+           # 5 tests potentially skipped because
+           # DOSISH systems already have a CRLF layer
+           # which will make new ones not stick.
+           @$expected = grep { $_ ne 'crlf' } @$expected;
+       }
        my $n = scalar @$expected;
-       is($n, scalar @$expected, "$id layers = $n");
+       is(scalar @$result, $n, "$id - layers == $n");
        for (my $i = 0; $i < $n; $i++) {
            my $j = $expected->[$i];
            if (ref $j eq 'CODE') {
-               ok($j->($result->[$i]), "$id $i is ok");
+               ok($j->($result->[$i]), "$id - $i is ok");
            } else {
                is($result->[$i], $j,
-                  sprintf("$id $i is %s", defined $j ? $j : "undef"));
+                  sprintf("$id - $i is %s",
+                          defined $j ? $j : "undef"));
            }
        }
     }
 
     check([ PerlIO::get_layers(STDIN) ],
-         [ "stdio" ],
+         $UTF8_STDIN ? [ "stdio", "utf8" ] : [ "stdio" ],
          "STDIN");
 
     open(F, ">:crlf", "afile");
@@ -83,10 +175,18 @@ use Config;
 
     binmode(F, ":raw :encoding(latin1)"); # "latin1" will be canonized
 
-    check([ PerlIO::get_layers(F, details => 1) ],
-         [ "stdio",    undef,        sub { $_[0] > 0 },
-           "encoding", "iso-8859-1", sub { $_[0] & PerlIO::F_UTF8() } ],
-         ":raw:encoding(latin1)");
+    # 7 tests potentially skipped.
+    unless ($DOSISH || !$FASTSTDIO) {
+       my @results = PerlIO::get_layers(F, details => 1);
+
+       # Get rid of the args and the flags.
+       splice(@results, 1, 2) if $NONSTDIO;
+
+       check([ @results ],
+             [ "stdio",    undef,        sub { $_[0] > 0 },
+               "encoding", "iso-8859-1", sub { $_[0] & PerlIO::F_UTF8() } ],
+             ":raw:encoding(latin1)");
+    }
 
     binmode(F);
 
@@ -98,6 +198,7 @@ use Config;
 
     {
        use open(IN => ":crlf", OUT => ":encoding(cp1252)");
+
        open F, "<afile";
        open G, ">afile";
 
@@ -113,5 +214,12 @@ use Config;
        close G;
     }
 
+    # Check that PL_sigwarn's reference count is correct, and that 
+    # &PerlIO::Layer::NoWarnings isn't prematurely freed.
+    fresh_perl_like (<<'EOT', qr/^CODE/);
+open(UTF, "<:raw:encoding(utf8)", "afile") or die $!;
+print ref *PerlIO::Layer::NoWarnings{CODE};
+EOT
+
     1 while unlink "afile";
 }