sv_2pv_flags and ROK and UTF8 flags

Date: Wed, 04 Sep 2002 21:09:01 -0700
Message-ID: <djtd9gzkgyLd092yn@efn.org>
Date: Fri, 06 Sep 2002 09:23:03 -0700
Message-ID: <nZNe9gzkgKdH092yn@efn.org>

p4raw-id: //depot/perl@17864

diff --git a/lib/overload.t b/lib/overload.t
index 4db647d..0798a91 100644 (file)
--- 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}

diff --git a/sv.c b/sv.c
index 824cc8e..6db4455 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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);
 }
 
 /*

diff --git a/sv.h b/sv.h
index 1d2c235..94366fe 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -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 8496f95..ed02ae3 100755 (executable)
--- 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