1#!perl -w 2 3BEGIN { require 'charset_tools.pl'; } 4 5use Test::More tests => 43; 6 7use XS::APItest; 8 9for my $func ('SvPVbyte_nolen', 'SvPVutf8_nolen') { 10 $g = *glob; 11 $r = \1; 12 is &$func($g), '*main::glob', "$func(\$glob_copy)"; 13 is ref\$g, 'GLOB', "$func(\$glob_copy) does not flatten the glob"; 14 is &$func($r), "$r", "$func(\$ref)"; 15 is ref\$r, 'REF', "$func(\$ref) does not flatten the ref"; 16 17 is &$func(*glob), '*main::glob', "$func(*glob)"; 18 is ref\$::{glob}, 'GLOB', "$func(*glob) does not flatten the glob"; 19 is &$func($^V), "$^V", "$func(\$ro_ref)"; 20 is ref\$^V, 'REF', "$func(\$ro_ref) does not flatten the ref"; 21} 22 23my $B6 = byte_utf8a_to_utf8n("\xC2\xB6"); 24my $individual_B6_utf8_bytes = ($::IS_ASCII) 25 ? "\xC3\x82\xC2\xB6" 26 : I8_to_native("\xC6\xB8\xC6\xA1"); 27my $data_bin = $B6; 28utf8::downgrade($data_bin); 29tie my $scalar_bin, 'TieScalarCounter', $data_bin; 30do { my $fetch = $scalar_bin }; 31is tied($scalar_bin)->{fetch}, 1; 32is tied($scalar_bin)->{store}, 0; 33my $len; 34is SvPVutf8_nomg($scalar_bin, $len), $individual_B6_utf8_bytes; 35is $len, length($individual_B6_utf8_bytes), "check len set by SvPVutf8_nomg"; 36is tied($scalar_bin)->{fetch}, 1; 37is tied($scalar_bin)->{store}, 0; 38undef $len; 39is SvPVbyte_nomg($scalar_bin, $len), $B6; 40is $len, length($B6), "check len set by SvPVbyte_nomg"; 41is tied($scalar_bin)->{fetch}, 1; 42is tied($scalar_bin)->{store}, 0; 43 44my $data_uni = $B6; 45utf8::upgrade($data_uni); 46tie my $scalar_uni, 'TieScalarCounter', $data_uni; 47do { my $fetch = $scalar_uni }; 48is tied($scalar_uni)->{fetch}, 1; 49is tied($scalar_uni)->{store}, 0; 50undef $len; 51is SvPVbyte_nomg($scalar_uni, $len), $B6; 52is $len, length($B6), "cheeck len set by SvPVbyte_nomg"; 53is tied($scalar_uni)->{fetch}, 1; 54is tied($scalar_uni)->{store}, 0; 55undef $len; 56is SvPVutf8_nomg($scalar_uni, $len), $individual_B6_utf8_bytes; 57is $len, length($individual_B6_utf8_bytes), "check len set by SvPVutf8_nomg"; 58is tied($scalar_uni)->{fetch}, 1; 59is tied($scalar_uni)->{store}, 0; 60 61undef $len; 62is SvPVutf8($scalar_bin, $len), $individual_B6_utf8_bytes; 63is $len, length $individual_B6_utf8_bytes; 64undef $len; 65is SvPVutf8($scalar_uni, $len), $individual_B6_utf8_bytes; 66is $len, length $individual_B6_utf8_bytes, "check len set by SvPVutf8"; 67 68eval 'SvPVbyte_nolen(*{chr 256})'; 69like $@, qr/^Wide character/, 'SvPVbyte_nolen fails on Unicode glob'; 70package r { use overload '""' => sub { substr "\x{100}\xff", -1 } } 71is SvPVbyte_nolen(bless [], r::), "\xff", 72 'SvPVbyte_nolen on ref returning downgradable utf8 string'; 73 74sub TIESCALAR { bless \(my $thing = pop), shift } 75sub FETCH { ${ +shift } } 76tie $tyre, main => bless [], r::; 77is SvPVbyte_nolen($tyre), "\xff", 78 'SvPVbyte on tie returning ref that returns downgradable utf8 string'; 79 80package TieScalarCounter; 81 82sub TIESCALAR { 83 my ($class, $value) = @_; 84 return bless { fetch => 0, store => 0, value => $value }, $class; 85} 86 87sub FETCH { 88 my ($self) = @_; 89 $self->{fetch}++; 90 return $self->{value}; 91} 92 93sub STORE { 94 my ($self, $value) = @_; 95 $self->{store}++; 96 $self->{value} = $value; 97} 98