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