ext/XS-APItest/t/svpv_magic.t

   1 #!perl -w
   2
   3 use Test::More tests => 10;
   4
   5 BEGIN {
   6     use_ok('XS::APItest');
   7     require 'charset_tools.pl';
   8 };
   9
  10 $b = "\303\244"; # or encode_utf8("\x{e4}");
  11
  12 is(XS::APItest::first_byte($b), 0303,
  13     "test function first_byte works");
  14
  15 $b =~ /(.)/;
  16 is(XS::APItest::first_byte($1), 0303,
  17     "matching works correctly");
  18
  19 $a = qq[\x{263a}]; # utf8 flag is set
  20
  21 $a =~ s/(.)/$1/;      # $1 now has the utf8 flag set too
  22 $b =~ /(.)/;          # $1 shouldn't have the utf8 flag anymore
  23
  24 is(XS::APItest::first_byte("$1"), 0303,
  25     "utf8 flag in match fetched correctly when stringified first");
  26
  27 $a =~ s/(.)/$1/;      # $1 now has the utf8 flag set too
  28 $b =~ /(.)/;          # $1 shouldn't have the utf8 flag anymore
  29
  30 is(eval { XS::APItest::first_byte($1) } || $@, 0303,
  31     "utf8 flag fetched correctly without stringification");
  32
  33 sub TIESCALAR { bless [], shift }
  34 sub FETCH { ++$f; *{chr utf8::unicode_to_native(255)} }
  35 tie $t, "main";
  36 is SvPVutf8($t), "*main::" . byte_utf8a_to_utf8n("\xc3\xbf"),
  37   'SvPVutf8 works with get-magic changing the SV type';
  38 is $f, 1, 'SvPVutf8 calls get-magic once';
  39
  40 package t {
  41   @ISA = 'main';
  42   sub FETCH { ++$::f; chr utf8::unicode_to_native(255) }
  43   sub STORE { }
  44 }
  45 tie $t, "t";
  46 undef $f;
  47 is SvPVutf8($t), byte_utf8a_to_utf8n("\xc3\xbf"),
  48   'SvPVutf8 works with get-magic downgrading the SV';
  49 is $f, 1, 'SvPVutf8 calls get-magic once';
  50 ()="$t";
  51 is $f, 2, 'SvPVutf8 does not stop stringification from calling FETCH';