https://perl5.git.perl.org / perl5.git / blame
| Commit | Line | Data |
|---|---|---|
| 78da4d13 JH |
1 | #!./perl -w |
| 2 | use strict; | |
| 3 | ||
| 4 | BEGIN { | |
| b5efbd1f | 5 | chdir 't' if -d 't'; |
| b5b7b9ad | 6 | require './test.pl'; |
| b5b7b9ad | 7 | skip_all_without_perlio(); |
| 78da4d13 JH |
8 | } |
| 9 | ||
| bf29d05f | 10 | plan tests => 8; |
| 78da4d13 JH |
11 | |
| 12 | # Some tests for UTF8 and format/write | |
| 13 | ||
| 14 | our ($bitem1, $uitem1) = ("\x{ff}", "\x{100}"); | |
| 15 | our ($bitem2, $uitem2) = ("\x{fe}", "\x{101}"); | |
| 16 | our ($blite1, $ulite1) = ("\x{fd}", "\x{102}"); | |
| 17 | our ($blite2, $ulite2) = ("\x{fc}", "\x{103}"); | |
| 18 | our ($bmulti, $umulti) = ("\x{fb}\n\x{fa}\n\x{f9}\n", | |
| 19 | "\x{104}\n\x{105}\n\x{106}\n"); | |
| 20 | ||
| 21 | sub 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 | ||
| 36 | fmwrtest OUT1 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (1)"; | |
| 37 | $blite1 @<< | |
| 38 | \$uitem1 | |
| 39 | $blite2 @<< | |
| 40 | \$bitem2 | |
| 41 | EOFORMAT | |
| 42 | $blite1 $uitem1 | |
| 43 | $blite2 $bitem2 | |
| 44 | EOEXPECT | |
| 45 | ||
| 46 | fmwrtest OUT2 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (2)"; | |
| 47 | $blite1 @<< | |
| 48 | \$bitem1 | |
| 49 | $blite2 @<< | |
| 50 | \$uitem2 | |
| 51 | EOFORMAT | |
| 52 | $blite1 $bitem1 | |
| 53 | $blite2 $uitem2 | |
| 54 | EOEXPECT | |
| 55 | ||
| 56 | fmwrtest OUT3 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (1)"; | |
| 57 | $ulite1 @<< | |
| 58 | \$bitem1 | |
| 59 | $blite2 @<< | |
| 60 | \$bitem2 | |
| 61 | EOFORMAT | |
| 62 | $ulite1 $bitem1 | |
| 63 | $blite2 $bitem2 | |
| 64 | EOEXPECT | |
| 65 | ||
| 66 | fmwrtest OUT4 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (2)"; | |
| 67 | $blite1 @<< | |
| 68 | \$bitem1 | |
| 69 | $ulite2 @<< | |
| 70 | \$bitem2 | |
| 71 | EOFORMAT | |
| 72 | $blite1 $bitem1 | |
| 73 | $ulite2 $bitem2 | |
| 74 | EOEXPECT | |
| 75 | ||
| 76 | fmwrtest OUT5 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 multiline"; | |
| 77 | $blite1 | |
| 78 | @* | |
| 79 | \$umulti | |
| 80 | $blite2 | |
| 81 | EOFORMAT | |
| 82 | $blite1 | |
| 83 | $umulti$blite2 | |
| 84 | EOEXPECT | |
| 85 | ||
| 86 | fmwrtest OUT6 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 multiline"; | |
| 87 | $ulite1 | |
| 88 | @* | |
| 89 | \$bmulti | |
| 90 | $blite2 | |
| 91 | EOFORMAT | |
| 92 | $ulite1 | |
| 93 | $bmulti$blite2 | |
| 94 | EOEXPECT | |
| 95 | ||
| bf29d05f BF |
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 | ||
| 107 | format 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 | ||
| 123 | unlink_all qw( Uni_write.tmp Uni_write2.tmp ); |