t/op/utf8cache.t

   1 #!./perl
   2 # Test for malfunctions of utf8 cache
   3
   4 BEGIN {
   5     chdir 't' if -d 't';
   6     @INC = '../lib';
   7 }
   8
   9 unless (eval { require Devel::Peek }) {
  10     print "# Without Devel::Peek, never mind\n";
  11     print "1..0\n";
  12     exit;
  13 }
  14 print "1..1\n";
  15
  16 my $pid = open CHILD, '-|';
  17 die "kablam: $!\n" unless defined $pid;
  18 unless ($pid) {
  19     open STDERR, ">&STDOUT";
  20     $a = "hello \x{1234}";
  21     for (1..2) {
  22         bar(substr($a, $_, 1));
  23     }
  24     sub bar {
  25         $_[0] = "\x{4321}";
  26         Devel::Peek::Dump($_[0]);
  27     }
  28     exit;
  29 }
  30
  31 { local $/; $_ = <CHILD> }
  32
  33 my $utf8magic = qr{ ^ \s+ MAGIC \s = .* \n
  34                       \s+ MG_VIRTUAL \s = .* \n
  35                       \s+ MG_TYPE \s = \s PERL_MAGIC_utf8 .* \n
  36                       \s+ MG_LEN \s = .* \n }xm;
  37
  38 if (m{ $utf8magic $utf8magic }x) {
  39     print "not ";
  40 }
  41 print "ok 1\n";