11 # Think carefully before adding tests here. In general this should be
12 # used only for about three categories of tests:
14 # (1) tests that absolutely require 'use utf8', and since that in general
15 # shouldn't be needed as the utf8 is being obsoleted, this should
16 # have rather few tests. If you want to test Unicode and regexes,
17 # you probably want to go to op/regexp or op/pat; if you want to test
18 # split, go to op/split; pack, op/pack; appending or joining,
19 # op/append or op/join, and so forth
21 # (2) tests that have to do with Unicode tokenizing (though it's likely
22 # that all the other Unicode tests sprinkled around the t/**/*.t are
23 # going to catch that)
25 # (3) complicated tests that simultaneously stress so many Unicode features
26 # that deciding into which other test script the tests should go to
27 # is hard -- maybe consider breaking up the complicated test
38 { use bytes; $a = "\xc3\xa4" }
39 { use utf8; $b = "\xe4" }
45 { use utf8; ok($a ne $b) }
52 my $smiley = "\x{263a}";
54 for my $s ("\x{263a}",
63 my $length_chars = length($s);
65 { use bytes; $length_bytes = length($s) }
66 my @regex_chars = $s =~ m/(.)/g;
67 my $regex_chars = @regex_chars;
68 my @split_chars = split //, $s;
69 my $split_chars = @split_chars;
70 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
74 for my $s ("\x{263a}" . "\x{263a}",
83 my $length_chars = length($s);
85 { use bytes; $length_bytes = length($s) }
86 my @regex_chars = $s =~ m/(.)/g;
87 my $regex_chars = @regex_chars;
88 my @split_chars = split //, $s;
89 my $split_chars = @split_chars;
90 ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
98 local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
99 my $x = eval q/"\\/ . "\x{100}" . q/"/;;
101 ok($w == 0 && $x eq "\x{100}");
111 $result .= '>' . join (',', map {ord} split //, $_) . '<'
117 eval $show or die $@; # We don't expect this sub definition to fail.
118 my $progfile = 'utf' . $$;
119 END {unlink_all $progfile}
121 # If I'm right 60 is '>' in ASCII, ' ' in EBCDIC
122 # 173 is not punctuation in either ASCII or EBCDIC
124 foreach (60, 173, 257, 65532) {
127 # I don't want to use map {ord} and I've no need to hardcode the UTF
129 my $charsubst = $char;
130 $charsubst =~ s/(.)/ord ($1) . ','/ge;
132 # Not testing this one against map {ord}
134 = join " . ", map {sprintf 'chr (%d)', ord $_} split //, $char;
135 push @char, [$_, $char, $charsubst, $char_as_ord];
137 # Now we've done all the UTF8 munching hopefully we're safe
139 ['check our detection program works',
140 'my @a = ("'.chr(60).'\x2A", ""); $b = show @a', qr/^>60,42<><$/],
141 ['check literal 8 bit input',
142 '$a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
143 ['check no utf8; makes no change',
144 'no utf8; $a = "' . chr (173) . '"; $b = show $a', qr/^>173<$/],
145 # Now we do the real byte sequences that are valid UTF8
147 ["the utf8 sequence for chr $_->[0]",
148 qq(\$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[2]<$/],
149 ["no utf8; for the utf8 sequence for chr $_->[0]",
150 qq(no utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[2]<$/],
151 ["use utf8; for the utf8 sequence for chr $_->[0]",
152 qq(use utf8; \$a = "$_->[1]"; \$b = show \$a), qr/^>$_->[0]<$/],
154 # Interpolation of hex characters needs to take place now, as we're
155 # testing feeding malformed utf8 into perl. Bug now fixed was an
156 # "out of memory" error. We really need the "" [rather than qq()
157 # or q()] to get the best explosion.
158 ["!Feed malformed utf8 into perl.", <<"BANG",
159 use utf8; %a = ("\xE1\xA0"=>"sterling");
160 print 'start'; printf '%x,', ord \$_ foreach keys %a; print "end\n";
162 qr/^Malformed UTF-8 character \(2 bytes, need 3.+\).*start\d+,end$/s
166 my ($why, $prog, $expect) = @$_;
167 open P, ">$progfile" or die "Can't open '$progfile': $!";
168 print P $show, $prog, '; print $b'
169 or die "Print to 'progfile' failed: $!";
170 close P or die "Can't close '$progfile': $!";
171 if ($why =~ s/^!//) {
172 print "# Possible delay...\n";
176 my $result = runperl ( stderr => 1, progfile => $progfile );
177 like ($result, $expect, $why);
180 "# Again! Again! [but this time as eval, and not the explosive one]\n";
181 # and now we've safely done them all as separate files, check that the
182 # evals do the same thing. Hopefully doing it later sucessfully decouples
183 # the previous tests from anything messy that may go wrong with the evals.
185 my ($why, $prog, $expect) = @$_;
186 next if $why =~ m/^!/; # Goes bang.
187 my $result = eval $prog;
189 print "# prog is $prog\n";
190 print "# \$\@=", _qq($@), "\n";
192 like ($result, $expect, $why);
195 # See what the tokeniser does with hash keys.
196 print "# What does the tokeniser do with utf8 hash keys?\n";
198 # This is the control - I don't expect it to fail
199 ["assign utf8 for chr $_->[0] to a hash",
200 qq(my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
201 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
203 ["no utf8; assign utf8 for chr $_->[0] to a hash",
204 qq(no utf8; my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
205 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
207 ["use utf8; assign utf8 for chr $_->[0] to a hash",
208 qq(use utf8; my \$a = "$_->[1]"; my %h; \$h{\$a} = 1;
209 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
211 # Now check literal $h{"x"} constructions.
212 ["\$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
213 qq(my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
214 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
216 ["no utf8; \$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
217 qq(no utf8; my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
218 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
220 ["use utf8; \$h{\"x\"} construction, where x is utf8 for chr $_->[0]",
221 qq(use utf8; my \$a = "$_->[1]"; my %h; \$h{"$_->[1]"} = 1;
222 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
224 # Now check "x" => constructions.
225 ["assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
226 qq(my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
227 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
229 ["no utf8; assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
230 qq(no utf8; my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
231 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
233 ["use utf8; assign \"x\"=>1 to a hash, where x is utf8 for chr $_->[0]",
234 qq(use utf8; my \$a = "$_->[1]"; my %h; %h = ("$_->[1]" => 1);
235 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
237 # Check copies of hashes made from literal utf8 keys
238 ["assign utf8 for chr $_->[0] to a hash, then copy it",
239 qq(my \$a = "$_->[1]"; my %i; \$i{\$a} = 1; my %h = %i;
240 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
242 ["no utf8; assign utf8 for chr $_->[0] to a hash, then copy it",
243 qq(no utf8; my \$a = "$_->[1]"; my %i; \$i{\$a} = 1;; my %h = %i;
244 my \$b = show keys %h; \$b .= 'F' unless \$h{$_->[3]}; \$b),
246 ["use utf8; assign utf8 for chr $_->[0] to a hash, then copy it",
247 qq(use utf8; my \$a = "$_->[1]"; my %i; \$i{\$a} = 1; my %h = %i;
248 my \$b = show keys %h; \$b .= 'F' unless \$h{chr $_->[0]}; \$b),
252 my ($why, $prog, $expect) = @$_;
254 my $result = eval $prog;
255 like ($result, $expect, $why);