| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | @INC = '../lib'; |
| 6 | } |
| 7 | |
| 8 | # NOTE! |
| 9 | # |
| 10 | # Think carefully before adding tests here. In general this should be |
| 11 | # used only for about three categories of tests: |
| 12 | # |
| 13 | # (1) tests that absolutely require 'use utf8', and since that in general |
| 14 | # shouldn't be needed as the utf8 is being obsoleted, this should |
| 15 | # have rather few tests. If you want to test Unicode and regexes, |
| 16 | # you probably want to go to op/regexp or op/pat; if you want to test |
| 17 | # split, go to op/split; pack, op/pack; appending or joining, |
| 18 | # op/append or op/join, and so forth |
| 19 | # |
| 20 | # (2) tests that have to do with Unicode tokenizing (though it's likely |
| 21 | # that all the other Unicode tests sprinkled around the t/**/*.t are |
| 22 | # going to catch that) |
| 23 | # |
| 24 | # (3) complicated tests that simultaneously stress so many Unicode features |
| 25 | # that deciding into which other test script the tests should go to |
| 26 | # is hard -- maybe consider breaking up the complicated test |
| 27 | # |
| 28 | # |
| 29 | |
| 30 | use Test; |
| 31 | plan tests => 15; |
| 32 | |
| 33 | { |
| 34 | # bug id 20001009.001 |
| 35 | |
| 36 | my ($a, $b); |
| 37 | |
| 38 | { use bytes; $a = "\xc3\xa4" } |
| 39 | { use utf8; $b = "\xe4" } |
| 40 | |
| 41 | my $test = 68; |
| 42 | |
| 43 | ok($a ne $b); |
| 44 | |
| 45 | { use utf8; ok($a ne $b) } |
| 46 | } |
| 47 | |
| 48 | |
| 49 | { |
| 50 | # bug id 20000730.004 |
| 51 | |
| 52 | my $smiley = "\x{263a}"; |
| 53 | |
| 54 | for my $s ("\x{263a}", |
| 55 | $smiley, |
| 56 | |
| 57 | "" . $smiley, |
| 58 | "" . "\x{263a}", |
| 59 | |
| 60 | $smiley . "", |
| 61 | "\x{263a}" . "", |
| 62 | ) { |
| 63 | my $length_chars = length($s); |
| 64 | my $length_bytes; |
| 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 |
| 71 | "1/1/1/3"); |
| 72 | } |
| 73 | |
| 74 | for my $s ("\x{263a}" . "\x{263a}", |
| 75 | $smiley . $smiley, |
| 76 | |
| 77 | "\x{263a}\x{263a}", |
| 78 | "$smiley$smiley", |
| 79 | |
| 80 | "\x{263a}" x 2, |
| 81 | $smiley x 2, |
| 82 | ) { |
| 83 | my $length_chars = length($s); |
| 84 | my $length_bytes; |
| 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 |
| 91 | "2/2/2/6"); |
| 92 | } |
| 93 | } |
| 94 | |
| 95 | |
| 96 | { |
| 97 | my $w = 0; |
| 98 | local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ }; |
| 99 | my $x = eval q/"\\/ . "\x{100}" . q/"/;; |
| 100 | |
| 101 | ok($w == 0 && $x eq "\x{100}"); |
| 102 | } |
| 103 | |