dist/threads-shared/t/utf8.t

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