chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ require './test.pl';
+ require './charset_tools.pl';
}
-use Test::More tests => 15;
+plan 11;
# open::import expects 'open' as its first argument, but it clashes with open()
sub import {
# this should fail
eval { import() };
-like( $@, qr/needs explicit list of disciplines/,
+like( $@, qr/needs explicit list of PerlIO layers/,
'import should fail without args' );
-# the hint bits shouldn't be set yet
-is( $^H & $open::hint_bits, 0,
- 'hint bits should not be set in $^H before open import' );
-
# prevent it from loading I18N::Langinfo, so we can test encoding failures
my $warn;
local $SIG{__WARN__} = sub {
$warn .= shift;
};
-# and it shouldn't be able to find this discipline
-eval{ import( 'IN', 'macguffin' ) };
-like( $warn, qr/Unknown discipline layer/,
- 'should warn about unknown discipline with bad discipline provided' );
+# and it shouldn't be able to find this layer
+$warn = '';
+eval q{ no warnings 'layer'; use open IN => ':macguffin' ; };
+is( $warn, '',
+ 'should not warn about unknown layer with bad layer provided' );
-SKIP: {
- skip("no perlio, no :utf8", 1) unless $Config{useperlio};
- # now load a real-looking locale
- $ENV{LC_ALL} = ' .utf8';
- import( 'IN', 'locale' );
- is( ${^OPEN}, ":utf8\0",
- 'should set a valid locale layer' );
-}
+$warn = '';
+eval q{ use warnings 'layer'; use open IN => ':macguffin' ; };
+like( $warn, qr/Unknown PerlIO layer/,
+ 'should warn about unknown layer with bad layer provided' );
+
+# open :locale logic changed since open 1.04, new logic
+# difficult to test portably.
-# and see if it sets the magic variables appropriately
+# see if it sets the magic variables appropriately
import( 'IN', ':crlf' );
-ok( $^H & $open::hint_bits,
- 'hint bits should be set in $^H after open import' );
is( $^H{'open_IN'}, 'crlf', 'should have set crlf layer' );
# it should reset them appropriately, too
# it dies if you don't set IN, OUT, or IO
eval { import( 'sideways', ':raw' ) };
-like( $@, qr/Unknown discipline class/, 'should croak with unknown class' );
+like( $@, qr/Unknown PerlIO layer class/, 'should croak with unknown class' );
# but it handles them all so well together
import( 'IO', ':raw :crlf' );
is( ${^OPEN}, ":raw :crlf\0:raw :crlf",
- 'should set multi types, multi disciplines' );
+ 'should set multi types, multi layer' );
is( $^H{'open_IO'}, 'crlf', 'should record last layer set in %^H' );
SKIP: {
- skip("no perlio, no :utf8", 4) unless $Config{'useperlio'};
-
- eval <<EOE;
- use open ':utf8';
- open(O, ">utf8");
- print O chr(0x100);
- close O;
- open(I, "<utf8");
- is(ord(<I>), 0x100, ":utf8 single wide character round-trip");
- close I;
-EOE
-
- open F, ">a";
- @a = map { chr(1 << ($_ << 2)) } 0..5; # 0x1, 0x10, .., 0x100000
- unshift @a, chr(0); # ... and a null byte in front just for fun
- print F @a;
- close F;
-
- sub systell {
- use Fcntl 'SEEK_CUR';
- sysseek($_[0], 0, SEEK_CUR);
- }
-
- require bytes; # not use
-
- my $ok;
-
- open F, "<:utf8", "a";
- $ok = $a = 0;
- for (@a) {
- unless (
- ($c = sysread(F, $b, 1)) == 1 &&
- length($b) == 1 &&
- ord($b) == ord($_) &&
- systell(F) == ($a += bytes::length($b))
- ) {
- print '# ord($_) == ', ord($_), "\n";
- print '# ord($b) == ', ord($b), "\n";
- print '# length($b) == ', length($b), "\n";
- print '# bytes::length($b) == ', bytes::length($b), "\n";
- print '# systell(F) == ', systell(F), "\n";
- print '# $a == ', $a, "\n";
- print '# $c == ', $c, "\n";
- last;
- }
- $ok++;
- }
- close F;
- ok($ok == @a,
- "on :utf8 streams sysread() should work on characters, not bytes");
-
- # syswrite() on should work on characters, not bytes
- open G, ">:utf8", "b";
- $ok = $a = 0;
- for (@a) {
- unless (
- ($c = syswrite(G, $_, 1)) == 1 &&
- systell(G) == ($a += bytes::length($_))
- ) {
- print '# ord($_) == ', ord($_), "\n";
- print '# bytes::length($_) == ', bytes::length($_), "\n";
- print '# systell(G) == ', systell(G), "\n";
- print '# $a == ', $a, "\n";
- print '# $c == ', $c, "\n";
- print "not ";
- last;
- }
- $ok++;
- }
- close G;
- ok($ok == @a,
- "on :utf8 streams syswrite() should work on characters, not bytes");
-
- open G, "<:utf8", "b";
- $ok = $a = 0;
- for (@a) {
- unless (
- ($c = sysread(G, $b, 1)) == 1 &&
- length($b) == 1 &&
- ord($b) == ord($_) &&
- systell(G) == ($a += bytes::length($_))
- ) {
- print '# ord($_) == ', ord($_), "\n";
- print '# ord($b) == ', ord($b), "\n";
- print '# length($b) == ', length($b), "\n";
- print '# bytes::length($b) == ', bytes::length($b), "\n";
- print '# systell(G) == ', systell(G), "\n";
- print '# $a == ', $a, "\n";
- print '# $c == ', $c, "\n";
- last;
- }
- $ok++;
- }
- close G;
- ok($ok == @a,
- "checking syswrite() output on :utf8 streams by reading it back in");
+ skip("no perlio", 1) unless (find PerlIO::Layer 'perlio');
+ skip("no Encode", 1) unless $Config{extensions} =~ m{\bEncode\b};
+ skip("EBCDIC platform doesnt have 'use encoding' used by open ':locale'", 1)
+ if $::IS_EBCDIC;
+
+ eval q[use Encode::Alias;use open ":std", ":locale"];
+ is($@, '', 'can use :std and :locale');
+}
+
+{
+ local $ENV{PERL_UNICODE};
+ delete $ENV{PERL_UNICODE};
+ local $TODO;
+ $TODO = "Encode not working on EBCDIC" if $::IS_EBCDIC;
+ is runperl(
+ progs => [
+ 'use open q\:encoding(UTF-8)\, q-:std-;',
+ 'use open q\:encoding(UTF-8)\;',
+ 'if(($_ = <STDIN>) eq qq-\x{100}\n-) { print qq-stdin ok\n- }',
+ 'else { print qq-got -, join(q q q, map ord, split//), "\n" }',
+ 'print STDOUT qq-\x{fe}\n-;',
+ 'print STDERR qq-\x{fe}\n-;',
+ ],
+ stdin => byte_utf8a_to_utf8n("\xc4\x80") . "\n",
+ stderr => 1,
+ ),
+ "stdin ok\n"
+ . byte_utf8a_to_utf8n("\xc3\xbe")
+ . "\n"
+ . byte_utf8a_to_utf8n("\xc3\xbe")
+ . "\n",
+ "use open without :std does not affect standard handles",
+ ;
}
END {
https://perl5.git.perl.org / perl5.git / blobdiff