summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2000-12-09 19:47:30 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2000-12-09 19:47:30 +0000
commit7d59b7e40bca518078f3e97c802950b76d52efa2 (patch)
tree53c65c30afe57d62fc8ebfa20197f1c74c0c9fd4 /t
parentbbc28b27949817e8e7461c0a92c6108632259a4b (diff)
downloadperl-7d59b7e40bca518078f3e97c802950b76d52efa2.tar.gz
Make print, syswrite, send, readline, getc honour utf8-ness of PerlIO.
(sysread, recv and write i.e. formats still to do...) Allow :utf8 or :bytes in PerlIO_apply_layers() so that open($fh,">:utf8","name") etc. work. - "applying" those just sets/clears the UTF8 bit of the top layer, so no extra overhead is involved. Tweak t/comp/require.t to add a 'use bytes' to permit its dubious writing of BOM to a non-utf8 stream. Add initial io/utf8.t Fix SvPVutf8() - sv_2pv() was not expecting to be called with something that was already SvPOK() - (we just fossiked with SvUTF8 bit). Fix that and also just use the SvPV macro in sv_2pvutf8() to avoid the issue/overhead. p4raw-id: //depot/perlio@8054
Diffstat (limited to 't')
-rwxr-xr-xt/comp/require.t3
-rwxr-xr-xt/io/utf8.t51
2 files changed, 53 insertions, 1 deletions
diff --git a/t/comp/require.t b/t/comp/require.t
index eaea3ad5f6..e634532275 100755
--- a/t/comp/require.t
+++ b/t/comp/require.t
@@ -21,6 +21,7 @@ sub write_file {
my $f = shift;
open(REQ,">$f") or die "Can't write '$f': $!";
binmode REQ;
+ use bytes;
print REQ @_;
close REQ;
}
@@ -132,7 +133,7 @@ $i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n));
sub bytes_to_utf16 {
my $utf16 = pack("$_[0]*", unpack("C*", $_[1]));
- return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16;
+ return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16;
}
$i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE
diff --git a/t/io/utf8.t b/t/io/utf8.t
new file mode 100755
index 0000000000..1e47c33d3f
--- /dev/null
+++ b/t/io/utf8.t
@@ -0,0 +1,51 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ unless ($Config{'useperlio'}) {
+ print "1..0 # Skip: not perlio\n";
+ exit 0;
+ }
+}
+
+$| = 1;
+print "1..11\n";
+
+open(F,"+>:utf8",'a');
+print F chr(0x100).'£';
+print '#'.tell(F)."\n";
+print "not " unless tell(F) == 4;
+print "ok 1\n";
+print F "\n";
+print '#'.tell(F)."\n";
+print "not " unless tell(F) >= 5;
+print "ok 2\n";
+seek(F,0,0);
+print "not " unless getc(F) eq chr(0x100);
+print "ok 3\n";
+print "not " unless getc(F) eq "£";
+print "ok 4\n";
+print "not " unless getc(F) eq "\n";
+print "ok 5\n";
+seek(F,0,0);
+binmode(F,":bytes");
+print "not " unless getc(F) eq chr(0xc4);
+print "ok 6\n";
+print "not " unless getc(F) eq chr(0x80);
+print "ok 7\n";
+print "not " unless getc(F) eq chr(0xc2);
+print "ok 8\n";
+print "not " unless getc(F) eq chr(0xa3);
+print "ok 9\n";
+print "not " unless getc(F) eq "\n";
+print "ok 10\n";
+seek(F,0,0);
+binmode(F,":utf8");
+print "not " unless scalar(<F>) eq "\x{100}£\n";
+print "ok 11\n";
+close(F);
+
+# unlink('a');
+