X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fio%2Flayers.t;h=c399b2ad8f5ad05d285803248d0adf4467c7d743;hb=584420f022db57225e9644b9c6668ff9f567984a;hp=1596d72f07f5ddc1fb3dcc3d98a9a4417aff452c;hpb=39f7a87036eb8d13c207511143dc7f2e620b3891;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/io/layers.t b/t/io/layers.t
index 1596d72..c399b2a 100644
--- 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";
 }