https://perl5.git.perl.org / perl5.git / blame
| Commit | Line | Data |
|---|---|---|
| 78da4d13 JH |
1 | #!./perl -w |
| 2 | use strict; | |
| 3 | ||
| 4 | BEGIN { | |
| 5 | chdir 't' if -d 't'; | |
| 6 | @INC = qw(../lib .); | |
| 7 | require "test.pl"; | |
| 3995db9d JH |
8 | unless (PerlIO::Layer->find('perlio')){ |
| 9 | print "1..0 # Skip: PerlIO required\n"; | |
| 10 | exit 0; | |
| 11 | } | |
| a901eef8 JH |
12 | if (ord("A") == 193) { |
| 13 | print "1..0 # Skip: EBCDIC porting needed\n"; | |
| 14 | exit 0; | |
| 15 | } | |
| 78da4d13 JH |
16 | } |
| 17 | ||
| 18 | plan tests => 6; | |
| 19 | ||
| 20 | # Some tests for UTF8 and format/write | |
| 21 | ||
| 22 | our ($bitem1, $uitem1) = ("\x{ff}", "\x{100}"); | |
| 23 | our ($bitem2, $uitem2) = ("\x{fe}", "\x{101}"); | |
| 24 | our ($blite1, $ulite1) = ("\x{fd}", "\x{102}"); | |
| 25 | our ($blite2, $ulite2) = ("\x{fc}", "\x{103}"); | |
| 26 | our ($bmulti, $umulti) = ("\x{fb}\n\x{fa}\n\x{f9}\n", | |
| 27 | "\x{104}\n\x{105}\n\x{106}\n"); | |
| 28 | ||
| 29 | sub fmwrtest { | |
| 30 | no strict 'refs'; | |
| 31 | my ($out, $format, $expect, $name) = @_; | |
| 32 | eval "format $out =\n$format.\n"; die $@ if $@; | |
| 33 | open $out, '>:utf8', 'Uni_write.tmp' or die "Can't create Uni_write.tmp"; | |
| 34 | write $out; | |
| 35 | close $out or die "Could not close $out: $!"; | |
| 36 | ||
| 37 | open UIN, '<:utf8', 'Uni_write.tmp' or die "Can't open Uni_write.tmp";; | |
| 38 | my $result = do { local $/; <UIN>; }; | |
| 39 | close UIN; | |
| 40 | ||
| 41 | is($result, $expect, $name); | |
| 42 | } | |
| 43 | ||
| 44 | fmwrtest OUT1 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (1)"; | |
| 45 | $blite1 @<< | |
| 46 | \$uitem1 | |
| 47 | $blite2 @<< | |
| 48 | \$bitem2 | |
| 49 | EOFORMAT | |
| 50 | $blite1 $uitem1 | |
| 51 | $blite2 $bitem2 | |
| 52 | EOEXPECT | |
| 53 | ||
| 54 | fmwrtest OUT2 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (2)"; | |
| 55 | $blite1 @<< | |
| 56 | \$bitem1 | |
| 57 | $blite2 @<< | |
| 58 | \$uitem2 | |
| 59 | EOFORMAT | |
| 60 | $blite1 $bitem1 | |
| 61 | $blite2 $uitem2 | |
| 62 | EOEXPECT | |
| 63 | ||
| 64 | fmwrtest OUT3 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (1)"; | |
| 65 | $ulite1 @<< | |
| 66 | \$bitem1 | |
| 67 | $blite2 @<< | |
| 68 | \$bitem2 | |
| 69 | EOFORMAT | |
| 70 | $ulite1 $bitem1 | |
| 71 | $blite2 $bitem2 | |
| 72 | EOEXPECT | |
| 73 | ||
| 74 | fmwrtest OUT4 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (2)"; | |
| 75 | $blite1 @<< | |
| 76 | \$bitem1 | |
| 77 | $ulite2 @<< | |
| 78 | \$bitem2 | |
| 79 | EOFORMAT | |
| 80 | $blite1 $bitem1 | |
| 81 | $ulite2 $bitem2 | |
| 82 | EOEXPECT | |
| 83 | ||
| 84 | fmwrtest OUT5 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 multiline"; | |
| 85 | $blite1 | |
| 86 | @* | |
| 87 | \$umulti | |
| 88 | $blite2 | |
| 89 | EOFORMAT | |
| 90 | $blite1 | |
| 91 | $umulti$blite2 | |
| 92 | EOEXPECT | |
| 93 | ||
| 94 | fmwrtest OUT6 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 multiline"; | |
| 95 | $ulite1 | |
| 96 | @* | |
| 97 | \$bmulti | |
| 98 | $blite2 | |
| 99 | EOFORMAT | |
| 100 | $ulite1 | |
| 101 | $bmulti$blite2 | |
| 102 | EOEXPECT | |
| 103 | ||
| 98a392ec | 104 | 1 while unlink 'Uni_write.tmp'; |