9 unless ($has_perlio = find PerlIO::Layer 'perlio') {
11 # Since you don't have perlio you might get failures with UTF-8 locales.
18 # Think carefully before adding tests here. In general this should be
19 # used only for about three categories of tests:
21 # (1) tests that absolutely require 'use utf8', and since that in general
22 # shouldn't be needed as the utf8 is being obsoleted, this should
23 # have rather few tests. If you want to test Unicode and regexes,
24 # you probably want to go to op/regexp or op/pat; if you want to test
25 # split, go to op/split; pack, op/pack; appending or joining,
26 # op/append or op/join, and so forth
28 # (2) tests that have to do with Unicode tokenizing (though it's likely
29 # that all the other Unicode tests sprinkled around the t/**/*.t are
30 # going to catch that)
32 # (3) complicated tests that simultaneously stress so many Unicode features
33 # that deciding into which other test script the tests should go to
34 # is hard -- maybe consider breaking up the complicated test
45 { use bytes; $a = "\xc3\xa4" }
46 { use utf8; $b = "\xe4" }
52 { use utf8; ok($a ne $b) }
59 my $smiley = "\x{263a}";
61 for my $s ("\x{263a}",
70 my $length_chars = length($s);
72 { use bytes; $length_bytes = length($s) }
73 my @regex_chars = $s =~ m/(.)/g;
74 my $regex_chars = @regex_chars;
75 my @split_chars = split //, $s;
76 my $split_chars = @split_chars;
77 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
81 for my $s ("\x{263a}" . "\x{263a}",
90 my $length_chars = length($s);
92 { use bytes; $length_bytes = length($s) }
93 my @regex_chars = $s =~ m/(.)/g;
94 my $regex_chars = @regex_chars;
95 my @split_chars = split //, $s;
96 my $split_chars = @split_chars;
97 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
105 local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
106 my $x = eval q/"\\/ . "\x{100}" . q/"/;;
108 ok($w == 0 && $x eq "\x{100}");
118 $result .= '>' . join (',', map {ord} split //, $_) . '<'
124 eval $show or die $@; # We don't expect this sub definition to fail.
125 my $progfile = 'utf' . $$;
126 END {unlink_all $progfile}
128 # If I'm right 60 is '>' in ASCII, ' ' in EBCDIC
129 # 173 is not punctuation in either ASCII or EBCDIC
131 foreach (60, 173, 257, 65532) {
134 # I don't want to use map {ord} and I've no need to hardcode the UTF
136 my $charsubst = $char;
137 $charsubst =~ s/(.)/ord ($1) . ','/ge;
139 # Not testing this one against map {ord}
141 = join " . ", map {sprintf 'chr (%d)', ord $_} split //, $char;
142 push @char, [$_, $char, $charsubst, $char_as_ord];
144 # Now we've done all the UTF8 munching hopefully we're safe
146 ['check our detection program works',
147 'my @a = ("'.chr(60).'\x2A", ""); $b = show @a', qr/^>60,42<><$/],
148 ['check literal 8 bit input',
149 '$a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
150 ['check no utf8; makes no change',
151 'no utf8; $a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
152 # Now we do the real byte sequences that are valid UTF8
154 ["the utf8 sequence for chr $_->[0]",
155 qq{\$a = "$_->[1]"; \$b = show \$a}, qr/^>$_->[2]<$/],
156 ["no utf8; for the utf8 sequence for chr $_->[0]",
157 qq(no utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[2]<$/],
158 ["use utf8; for the utf8 sequence for chr $_->[0]",
159 qq(use utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[0]<$/],
161 # Interpolation of hex characters needs to take place now, as we're
162 # testing feeding malformed utf8 into perl. Bug now fixed was an
163 # "out of memory" error. We really need the "" [rather than qq()
164 # or q()] to get the best explosion.
165 ["!Feed malformed utf8 into perl.", <<"BANG",
166 use utf8; %a = ("\xE1\xA0"=>"sterling");
167 print 'start'; printf '%x,', ord \$_ foreach keys %a; print "end\n";
169 qr/^Malformed UTF-8 character \(2 bytes, need 3.+\).*start\d+,end$/s
173 my ($why, $prog, $expect) = @$_;
174 open P, ">$progfile" or die "Can't open '$progfile': $!";
175 binmode(P, ":bytes") if $has_perlio;
176 print P $show, $prog, '; print $b'
177 or die "Print to 'progfile' failed: $!";
178 close P or die "Can't close '$progfile': $!";
179 if ($why =~ s/^!//) {
180 print "# Possible delay...\n";
184 my $result = runperl ( stderr => 1, progfile => $progfile );
185 like ($result, $expect, $why);
188 "# Again! Again! [but this time as eval, and not the explosive one]\n";
189 # and now we've safely done them all as separate files, check that the
190 # evals do the same thing. Hopefully doing it later sucessfully decouples
191 # the previous tests from anything messy that may go wrong with the evals.
193 my ($why, $prog, $expect) = @$_;
194 next if $why =~ m/^!/; # Goes bang.
195 my $result = eval $prog;
197 print "# prog is $prog\n";
198 print "# \$\@=", _qq($@), "\n";
200 like ($result, $expect, $why);
203 # See what the tokeniser does with hash keys.
204 print "# What does the tokeniser do with utf8 hash keys?\n";
206 # This is the control - I don't expect it to fail
207 ["assign utf8 for chr $_->[0] to a hash",
208 qq(my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
209 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
211 ["no utf8; assign utf8 for chr $_->[0] to a hash",
212 qq(no utf8; my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
213 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
215 ["use utf8; assign utf8 for chr $_->[0] to a hash",
216 qq(use utf8; my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
217 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
219 # Now check literal $h{"x"} constructions.
220 ["\$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
221 qq(my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
222 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
224 ["no utf8; \$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
225 qq(no utf8; my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
226 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
228 ["use utf8; \$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
229 qq(use utf8; my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
230 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
232 # Now check "x" => constructions.
233 ["assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
234 qq(my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
235 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
237 ["no utf8; assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
238 qq(no utf8; my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
239 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
241 ["use utf8; assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
242 qq(use utf8; my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
243 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
245 # Check copies of hashes made from literal utf8 keys
246 ["assign utf8 for chr $_->[0] to a hash, then copy it",
247 qq(my \$a = "$_->[1]"; my %i; \$i{\$a} = 1; my %h = %i;
248 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
250 ["no utf8; assign utf8 for chr $_->[0] to a hash, then copy it",
251 qq(no utf8; my \$a = "$_->[1]"; my %i; \$i{\$a} = 1;; my %h = %i;
252 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
254 ["use utf8; assign utf8 for chr $_->[0] to a hash, then copy it",
255 qq(use utf8; my \$a = "$_->[1]"; my %i; \$i{\$a} = 1; my %h = %i;
256 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
260 my ($why, $prog, $expect) = @$_;
262 my $result = eval $prog;
263 like ($result, $expect, $why);