add Porting/core-cpan-diff
[perl.git] / ext / threads-shared / t / utf8.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     if ($ENV{'PERL_CORE'}){
6         chdir 't';
7         unshift @INC, '../lib';
8     }
9     use Config;
10     if (! $Config{'useithreads'}) {
11         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
12         exit(0);
13     }
14 }
15
16 use ExtUtils::testlib;
17
18 my $TEST = 1;
19
20 sub is {
21     my ($got, $exp, $name) = @_;
22
23     my $ok = ($got eq $exp);
24
25     # You have to do it this way or VMS will get confused.
26     if ($ok) {
27         print("ok $TEST - $name\n");
28     } else {
29         print("not ok $TEST - $name\n");
30         printf("# Failed test at line %d\n", (caller)[2]);
31         print("#   Got:      $got\n");
32         print("#   Expected: $exp\n");
33     }
34
35     $TEST++;
36
37     return ($ok);
38 }
39
40 BEGIN {
41     $| = 1;
42     print("1..12\n");   ### Number of tests that will be run ###
43 };
44
45 use threads;
46 use threads::shared;
47
48 ### Start of Testing ###
49
50 binmode STDOUT, ":utf8";
51
52 my $plain = 'foo';
53 my $utf8 = "\x{123}\x{84}\x{20F}\x{2C1}";
54 my $code = \&is;
55
56 my %a :shared;
57 $a{$plain} = $plain;
58 $a{$utf8} = $utf8;
59 $a{$code} = 'code';
60
61 is(exists($a{$plain}), 1, 'Found plain key in shared hash');
62 is(exists($a{$utf8}), 1, 'Found UTF-8 key in shared hash');
63 is(exists($a{$code}), 1, 'Found code ref key in shared hash');
64
65 while (my ($key, $value) = each (%a)) {
66     if ($key eq $plain) {
67         is($key, $plain, 'Plain key in shared hash');
68     } elsif ($key eq $utf8) {
69         is($key, $utf8, 'UTF-8 key in shared hash');
70     } elsif ($key eq "$code") {
71         is($key, "$code", 'Code ref key in shared hash');
72     } else {
73         is($key, "???", 'Bad key');
74     }
75 }
76
77 my $a = &share({});
78 $$a{$plain} = $plain;
79 $$a{$utf8} = $utf8;
80 $$a{$code} = 'code';
81
82 is(exists($$a{$plain}), 1, 'Found plain key in shared hash ref');
83 is(exists($$a{$utf8}), 1, 'Found UTF-8 key in shared hash ref');
84 is(exists($$a{$code}), 1, 'Found code ref key in shared hash ref');
85
86 while (my ($key, $value) = each (%$a)) {
87     if ($key eq $plain) {
88         is($key, $plain, 'Plain key in shared hash ref');
89     } elsif ($key eq $utf8) {
90         is($key, $utf8, 'UTF-8 key in shared hash ref');
91     } elsif ($key eq "$code") {
92         is($key, "$code", 'Code ref key in shared hash ref');
93     } else {
94         is($key, "???", 'Bad key');
95     }
96 }
97
98 exit(0);
99
100 # EOF