t/uni/write.t

   1 #!./perl -w
   2 use strict;
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     @INC = qw(../lib .);
   7     require "test.pl";
   8     unless (PerlIO::Layer->find('perlio')){
   9         print "1..0 # Skip: PerlIO required\n";
  10         exit 0;
  11     }
  12     if (ord("A") == 193) {
  13         print "1..0 # Skip: EBCDIC porting needed\n";
  14         exit 0;
  15     }
  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
 104 1 while unlink 'Uni_write.tmp';