diff options
| -rw-r--r-- | lib/overload.t | 15 | ||||
| -rw-r--r-- | sv.c | 42 | ||||
| -rw-r--r-- | sv.h | 2 | ||||
| -rwxr-xr-x | t/op/pat.t | 21 |
4 files changed, 47 insertions, 33 deletions
diff --git a/lib/overload.t b/lib/overload.t index 4db647dbee..0798a91b9f 100644 --- a/lib/overload.t +++ b/lib/overload.t @@ -41,7 +41,7 @@ sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead package main; -$test = 0; +our $test = 0; $| = 1; print "1..",&last,"\n"; @@ -1064,9 +1064,10 @@ package main; my $utfvar = new utf8_o 200.2.1; -test("$utfvar" eq 200.2.1); # 223 +test("$utfvar" eq 200.2.1); # 223 - stringify +test("a$utfvar" eq "a".200.2.1); # 224 - overload via sv_2pv_flags -# 224..226 -- more %{} tests. Hangs in 5.6.0, okay in later releases. +# 225..227 -- more %{} tests. Hangs in 5.6.0, okay in later releases. # Basically this example implements strong encapsulation: if Hderef::import() # were to eval the overload code in the caller's namespace, the privatisation # would be quite transparent. @@ -1080,9 +1081,9 @@ sub xet { @_ == 2 ? $_[0]->{$_[1]} : package main; my $a = Foo->new; $a->xet('b', 42); -print $a->xet('b') == 42 ? "ok 224\n" : "not ok 224\n"; -print defined eval { $a->{b} } ? "not ok 225\n" : "ok 225\n"; -print $@ =~ /zap/ ? "ok 226\n" : "not ok 226\n"; +print $a->xet('b') == 42 ? "ok 225\n" : "not ok 225\n"; +print defined eval { $a->{b} } ? "not ok 226\n" : "ok 226\n"; +print $@ =~ /zap/ ? "ok 227\n" : "not ok 227\n"; # Last test is: -sub last {226} +sub last {227} @@ -2935,8 +2935,14 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) if (SvROK(sv)) { SV* tmpstr; if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) && - (SvTYPE(tmpstr) != SVt_RV || (SvRV(tmpstr) != SvRV(sv)))) - return SvPV(tmpstr,*lp); + (SvTYPE(tmpstr) != SVt_RV || (SvRV(tmpstr) != SvRV(sv)))) { + char *pv = SvPV(tmpstr, *lp); + if (SvUTF8(tmpstr)) + SvUTF8_on(sv); + else + SvUTF8_off(sv); + return pv; + } sv = (SV*)SvRV(sv); if (!sv) s = "NULLREF"; @@ -3193,28 +3199,16 @@ would lose the UTF-8'ness of the PV. void Perl_sv_copypv(pTHX_ SV *dsv, register SV *ssv) { - SV *tmpsv; - - if ( SvTHINKFIRST(ssv) && SvROK(ssv) && SvAMAGIC(ssv) && - (tmpsv = AMG_CALLun(ssv,string))) { - if (SvTYPE(tmpsv) != SVt_RV || (SvRV(tmpsv) != SvRV(ssv))) { - SvSetSV(dsv,tmpsv); - return; - } - } else { - tmpsv = sv_newmortal(); - } - { - STRLEN len; - char *s; - s = SvPV(ssv,len); - sv_setpvn(tmpsv,s,len); - if (SvUTF8(ssv)) - SvUTF8_on(tmpsv); - else - SvUTF8_off(tmpsv); - SvSetSV(dsv,tmpsv); - } + SV *tmpsv = sv_newmortal(); + STRLEN len; + char *s; + s = SvPV(ssv,len); + sv_setpvn(tmpsv,s,len); + if (SvUTF8(ssv)) + SvUTF8_on(tmpsv); + else + SvUTF8_off(tmpsv); + SvSetSV(dsv,tmpsv); } /* @@ -207,7 +207,7 @@ perform the upgrade if necessary. See C<svtype>. #define SVp_POK 0x04000000 /* has valid non-public pointer value */ #define SVp_SCREAM 0x08000000 /* has been studied? */ -#define SVf_UTF8 0x20000000 /* SvPVX is UTF-8 encoded */ +#define SVf_UTF8 0x20000000 /* SvPV is UTF-8 encoded */ #define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE) diff --git a/t/op/pat.t b/t/op/pat.t index 8496f95a1e..ed02ae3126 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -6,7 +6,7 @@ $| = 1; -print "1..924\n"; +print "1..928\n"; BEGIN { chdir 't' if -d 't'; @@ -2911,3 +2911,22 @@ print(('goodfood' =~ $a ? '' : 'not '), print(($a eq '(?-xism:foo)' ? '' : 'not '), "ok $test\t# reblessed qr// stringizes\n"); ++$test; + +$x = "\x{3fe}"; +$a = qr/$x/; +print(($x =~ $a ? '' : 'not '), "ok $test - utf8 interpolation in qr//\n"); +++$test; + +print(("a$a" =~ $x ? '' : 'not '), + "ok $test - stringifed qr// preserves utf8 # TODO\n"); +++$test; + +print(("a$x" =~ qr/a$a/ ? '' : 'not '), + "ok $test - interpolated qr// preserves utf8 # TODO\n"); +++$test; + +print(("a$x" =~ qr/a(??{$a})/ ? '' : 'not '), + "ok $test - postponed interpolation of qr// preserves utf8 # TODO\n"); +++$test; + +# last test 928 |