185009909Smillert#!./perl -w 285009909Smillertuse strict; 385009909Smillert 485009909SmillertBEGIN { 5*b8851fccSafresh1 chdir 't' if -d 't'; 6898184e3Ssthen require './test.pl'; 7898184e3Ssthen skip_all_without_perlio(); 885009909Smillert} 985009909Smillert 10898184e3Ssthenplan tests => 8; 1185009909Smillert 1285009909Smillert# Some tests for UTF8 and format/write 1385009909Smillert 1485009909Smillertour ($bitem1, $uitem1) = ("\x{ff}", "\x{100}"); 1585009909Smillertour ($bitem2, $uitem2) = ("\x{fe}", "\x{101}"); 1685009909Smillertour ($blite1, $ulite1) = ("\x{fd}", "\x{102}"); 1785009909Smillertour ($blite2, $ulite2) = ("\x{fc}", "\x{103}"); 1885009909Smillertour ($bmulti, $umulti) = ("\x{fb}\n\x{fa}\n\x{f9}\n", 1985009909Smillert "\x{104}\n\x{105}\n\x{106}\n"); 2085009909Smillert 2185009909Smillertsub fmwrtest { 2285009909Smillert no strict 'refs'; 2385009909Smillert my ($out, $format, $expect, $name) = @_; 2485009909Smillert eval "format $out =\n$format.\n"; die $@ if $@; 2585009909Smillert open $out, '>:utf8', 'Uni_write.tmp' or die "Can't create Uni_write.tmp"; 2685009909Smillert write $out; 2785009909Smillert close $out or die "Could not close $out: $!"; 2885009909Smillert 2985009909Smillert open UIN, '<:utf8', 'Uni_write.tmp' or die "Can't open Uni_write.tmp";; 3085009909Smillert my $result = do { local $/; <UIN>; }; 3185009909Smillert close UIN; 3285009909Smillert 3385009909Smillert is($result, $expect, $name); 3485009909Smillert} 3585009909Smillert 3685009909Smillertfmwrtest OUT1 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (1)"; 3785009909Smillert$blite1 @<< 3885009909Smillert\$uitem1 3985009909Smillert$blite2 @<< 4085009909Smillert\$bitem2 4185009909SmillertEOFORMAT 4285009909Smillert$blite1 $uitem1 4385009909Smillert$blite2 $bitem2 4485009909SmillertEOEXPECT 4585009909Smillert 4685009909Smillertfmwrtest OUT2 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (2)"; 4785009909Smillert$blite1 @<< 4885009909Smillert\$bitem1 4985009909Smillert$blite2 @<< 5085009909Smillert\$uitem2 5185009909SmillertEOFORMAT 5285009909Smillert$blite1 $bitem1 5385009909Smillert$blite2 $uitem2 5485009909SmillertEOEXPECT 5585009909Smillert 5685009909Smillertfmwrtest OUT3 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (1)"; 5785009909Smillert$ulite1 @<< 5885009909Smillert\$bitem1 5985009909Smillert$blite2 @<< 6085009909Smillert\$bitem2 6185009909SmillertEOFORMAT 6285009909Smillert$ulite1 $bitem1 6385009909Smillert$blite2 $bitem2 6485009909SmillertEOEXPECT 6585009909Smillert 6685009909Smillertfmwrtest OUT4 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (2)"; 6785009909Smillert$blite1 @<< 6885009909Smillert\$bitem1 6985009909Smillert$ulite2 @<< 7085009909Smillert\$bitem2 7185009909SmillertEOFORMAT 7285009909Smillert$blite1 $bitem1 7385009909Smillert$ulite2 $bitem2 7485009909SmillertEOEXPECT 7585009909Smillert 7685009909Smillertfmwrtest OUT5 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 multiline"; 7785009909Smillert$blite1 7885009909Smillert@* 7985009909Smillert\$umulti 8085009909Smillert$blite2 8185009909SmillertEOFORMAT 8285009909Smillert$blite1 8385009909Smillert$umulti$blite2 8485009909SmillertEOEXPECT 8585009909Smillert 8685009909Smillertfmwrtest OUT6 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 multiline"; 8785009909Smillert$ulite1 8885009909Smillert@* 8985009909Smillert\$bmulti 9085009909Smillert$blite2 9185009909SmillertEOFORMAT 9285009909Smillert$ulite1 9385009909Smillert$bmulti$blite2 9485009909SmillertEOEXPECT 9585009909Smillert 96898184e3Ssthen{ 97898184e3Ssthen use utf8; 98898184e3Ssthen use open qw( :utf8 :std ); 99898184e3Ssthen 100898184e3Ssthen local $~ = "놋웇ʱＦᚖṀŦ"; 101898184e3Ssthen eval { write }; 102898184e3Ssthen like $@, qr/Undefined format "놋웇ʱＦᚖṀŦ/u, 'no such format, with format name in UTF-8.'; 103898184e3Ssthen} 104898184e3Ssthen 105898184e3Ssthen{ 106898184e3Ssthen 107898184e3Ssthenformat OUT = 108898184e3Ssthen 109898184e3Ssthen 110898184e3Ssthen. 111898184e3Ssthen use utf8; 112898184e3Ssthen use open qw( :utf8 :std ); 113898184e3Ssthen open OUT, '>', 'Uni_write2.tmp'; 114898184e3Ssthen 115898184e3Ssthen my $oldfh = select OUT; 116898184e3Ssthen local $^ = "უデfiᕣネḓ_ＦᚖṀŦɐȾ";#"UNDEFINED_FORMAT"; 117898184e3Ssthen eval { write }; 118898184e3Ssthen like $@, qr/Undefined top format "უデfiᕣネḓ_ＦᚖṀŦɐȾ/u, 'no such top format'; 119898184e3Ssthen select $oldfh; 120898184e3Ssthen close OUT; 121898184e3Ssthen} 122898184e3Ssthen 123898184e3Ssthenunlink_all qw( Uni_write.tmp Uni_write2.tmp ); 124