t/uni/write.t

   1 #!./perl -w
   2 use strict;
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     require './test.pl';
   7     skip_all_without_perlio();
   8 }
   9
  10 plan tests => 8;
  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
  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 $^ = "უデﬁᕣネḓ_ＦᚖṀŦɐȾ";#"UNDEFINED_FORMAT";
 117     eval { write };
 118     like $@, qr/Undefined top format "უデﬁᕣネḓ_ＦᚖṀŦɐȾ/u, 'no such top format';
 119     select $oldfh;
 120     close OUT;
 121 }
 122
 123 unlink_all qw( Uni_write.tmp Uni_write2.tmp );