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