1#!./perl -w 2use strict; 3 4BEGIN { 5 chdir 't' if -d 't'; 6 require './test.pl'; 7 skip_all_without_perlio(); 8} 9 10plan tests => 8; 11 12# Some tests for UTF8 and format/write 13 14our ($bitem1, $uitem1) = ("\x{ff}", "\x{100}"); 15our ($bitem2, $uitem2) = ("\x{fe}", "\x{101}"); 16our ($blite1, $ulite1) = ("\x{fd}", "\x{102}"); 17our ($blite2, $ulite2) = ("\x{fc}", "\x{103}"); 18our ($bmulti, $umulti) = ("\x{fb}\n\x{fa}\n\x{f9}\n", 19 "\x{104}\n\x{105}\n\x{106}\n"); 20 21sub fmwrtest { 22 no strict 'refs'; 23 my ($out, $format, $expect, $name) = @_; 24 eval "format $out =\n$format.\n"; die $@ if $@; 25 open $out, '>:utf8', 'Uni_write.tmp' or die "Can't create Uni_write.tmp"; 26 write $out; 27 close $out or die "Could not close $out: $!"; 28 29 open UIN, '<:utf8', 'Uni_write.tmp' or die "Can't open Uni_write.tmp";; 30 my $result = do { local $/; <UIN>; }; 31 close UIN; 32 33 is($result, $expect, $name); 34} 35 36fmwrtest OUT1 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (1)"; 37$blite1 @<< 38\$uitem1 39$blite2 @<< 40\$bitem2 41EOFORMAT 42$blite1 $uitem1 43$blite2 $bitem2 44EOEXPECT 45 46fmwrtest OUT2 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (2)"; 47$blite1 @<< 48\$bitem1 49$blite2 @<< 50\$uitem2 51EOFORMAT 52$blite1 $bitem1 53$blite2 $uitem2 54EOEXPECT 55 56fmwrtest OUT3 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (1)"; 57$ulite1 @<< 58\$bitem1 59$blite2 @<< 60\$bitem2 61EOFORMAT 62$ulite1 $bitem1 63$blite2 $bitem2 64EOEXPECT 65 66fmwrtest OUT4 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (2)"; 67$blite1 @<< 68\$bitem1 69$ulite2 @<< 70\$bitem2 71EOFORMAT 72$blite1 $bitem1 73$ulite2 $bitem2 74EOEXPECT 75 76fmwrtest OUT5 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 multiline"; 77$blite1 78@* 79\$umulti 80$blite2 81EOFORMAT 82$blite1 83$umulti$blite2 84EOEXPECT 85 86fmwrtest OUT6 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 multiline"; 87$ulite1 88@* 89\$bmulti 90$blite2 91EOFORMAT 92$ulite1 93$bmulti$blite2 94EOEXPECT 95 96{ 97 use utf8; 98 use open qw( :utf8 :std ); 99 100 local $~ = "놋웇ʱＦᚖṀŦ"; 101 eval { write }; 102 like $@, qr/Undefined format "놋웇ʱＦᚖṀŦ/u, 'no such format, with format name in UTF-8.'; 103} 104 105{ 106 107format OUT = 108 109 110. 111 use utf8; 112 use open qw( :utf8 :std ); 113 open OUT, '>', 'Uni_write2.tmp'; 114 115 my $oldfh = select OUT; 116 local $^ = "უデfiᕣネḓ_ＦᚖṀŦɐȾ";#"UNDEFINED_FORMAT"; 117 eval { write }; 118 like $@, qr/Undefined top format "უデfiᕣネḓ_ＦᚖṀŦɐȾ/u, 'no such top format'; 119 select $oldfh; 120 close OUT; 121} 122 123unlink_all qw( Uni_write.tmp Uni_write2.tmp ); 124