[MERGE] fix PERL_GLOBAL_STRUCT builds
[perl.git] / t / op / split_unicode.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6 }
7
8 skip_all_if_miniperl("no dynamic loading on miniperl, no File::Spec (used by charnames)");
9 plan(tests => 145);
10
11 {
12     # check the special casing of split /\s/ and unicode
13     use charnames qw(:full);
14     # below test data is extracted from
15     # PropList-5.0.0.txt
16     # Date: 2006-06-07, 23:22:52 GMT [MD]
17     #
18     # Unicode Character Database
19     # Copyright (c) 1991-2006 Unicode, Inc.
20     # For terms of use, see http://www.unicode.org/terms_of_use.html
21     # For documentation, see UCD.html
22     my @spaces=(
23         ord("\t"),      # Cc       <control-0009>
24         ord("\n"),      # Cc       <control-000A>
25         # not PerlSpace # Cc       <control-000B>
26         ord("\f"),      # Cc       <control-000C>
27         ord("\r"),      # Cc       <control-000D>
28         ord(" "),       # Zs       SPACE
29         ord("\N{NEL}"), # Cc       <control-0085>
30         ord("\N{NO-BREAK SPACE}"),
31                         # Zs       NO-BREAK SPACE
32         0x1680,         # Zs       OGHAM SPACE MARK
33         0x2000..0x200A, # Zs  [11] EN QUAD..HAIR SPACE
34         0x2028,         # Zl       LINE SEPARATOR
35         0x2029,         # Zp       PARAGRAPH SEPARATOR
36         0x202F,         # Zs       NARROW NO-BREAK SPACE
37         0x205F,         # Zs       MEDIUM MATHEMATICAL SPACE
38         0x3000          # Zs       IDEOGRAPHIC SPACE
39     );
40     #diag "Have @{[0+@spaces]} to test\n";
41     foreach my $cp (@spaces) {
42         my $msg = sprintf "Space: U+%04x", $cp;
43         my $space = chr($cp);
44         my $str="A:$space:B\x{FFFD}";
45         chop $str;
46
47         my @res=split(/\s+/,$str);
48         my $cnt=split(/\s+/,$str);
49         ok(@res == 2 && join('-',@res) eq "A:-:B", "$msg - /\\s+/");
50         is($cnt, scalar(@res), "$msg - /\\s+/ (count)");
51
52         my $s2 = "$space$space:A:$space$space:B\x{FFFD}";
53         chop $s2;
54
55         my @r2 = split(' ',$s2);
56         my $c2 = split(' ',$s2);
57         ok(@r2 == 2 && join('-', @r2) eq ":A:-:B",  "$msg - ' '");
58         is($c2, scalar(@r2), "$msg - ' ' (count)");
59
60         my @r3 = split(/\s+/, $s2);
61         my $c3 = split(/\s+/, $s2);
62         ok(@r3 == 3 && join('-', @r3) eq "-:A:-:B", "$msg - /\\s+/ No.2");
63         is($c3, scalar(@r3), "$msg - /\\s+/ No.2 (count)");
64     }
65
66     { # RT #114808
67         warning_is(
68             sub {
69                 $p=chr(0x100);
70                 for (".","ab\x{101}def") {
71                     @q = split /$p/
72                 }
73             },
74             undef,
75             'no warnings when part of split cant match non-utf8'
76         );
77     }
78
79 }