This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5db: add tests for v command
[perl5.git] / 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 $~ = "놋웇ʱFᚖṀŦ";
101     eval { write };
102     like $@, qr/Undefined format "놋웇ʱFᚖṀŦ/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ᕣネḓ_FᚖṀŦɐȾ";#"UNDEFINED_FORMAT";
117     eval { write };
118     like $@, qr/Undefined top format "უデfiᕣネḓ_FᚖṀŦɐȾ/u, 'no such top format';
119     select $oldfh;
120     close OUT;
121 }
122
123 unlink_all qw( Uni_write.tmp Uni_write2.tmp );