1#!perl -w 2 3use Test::More tests => 10; 4 5BEGIN { 6 use_ok('XS::APItest'); 7 require 'charset_tools.pl'; 8}; 9 10$b = "\303\244"; # or encode_utf8("\x{e4}"); 11 12is(XS::APItest::first_byte($b), 0303, 13 "test function first_byte works"); 14 15$b =~ /(.)/; 16is(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 24is(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 30is(eval { XS::APItest::first_byte($1) } || $@, 0303, 31 "utf8 flag fetched correctly without stringification"); 32 33sub TIESCALAR { bless [], shift } 34sub FETCH { ++$f; *{chr utf8::unicode_to_native(255)} } 35tie $t, "main"; 36is SvPVutf8_nolen($t), "*main::" . byte_utf8a_to_utf8n("\xc3\xbf"), 37 'SvPVutf8 works with get-magic changing the SV type'; 38is $f, 1, 'SvPVutf8 calls get-magic once'; 39 40package t { 41 @ISA = 'main'; 42 sub FETCH { ++$::f; chr utf8::unicode_to_native(255) } 43 sub STORE { } 44} 45tie $t, "t"; 46undef $f; 47is SvPVutf8_nolen($t), byte_utf8a_to_utf8n("\xc3\xbf"), 48 'SvPVutf8 works with get-magic downgrading the SV'; 49is $f, 1, 'SvPVutf8 calls get-magic once'; 50()="$t"; 51is $f, 2, 'SvPVutf8 does not stop stringification from calling FETCH'; 52