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