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