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