pp.c: pp_substr for UTF-8 globs.

Since typeglobs may have the UTF8 flag set now, we need to avoid
testing SvCUR on a potential glob, as that would trip an assertion.

diff --git a/pp.c b/pp.c
index 9250751..a102a21 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2978,7 +2978,7 @@ PP(pp_substr)
        if (num_args > 3) {
          if((repl_sv = POPs)) {
            repl = SvPV_const(repl_sv, repl_len);
-           repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
+           repl_is_utf8 = DO_UTF8(repl_sv) && repl_len;
          }
          else num_args--;
        }
@@ -3112,7 +3112,7 @@ PP(pp_substr)
                repl_sv_copy = newSVsv(repl_sv);
                sv_utf8_upgrade(repl_sv_copy);
                repl = SvPV_const(repl_sv_copy, repl_len);
-               repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
+               repl_is_utf8 = DO_UTF8(repl_sv_copy) && repl_len;
            }
            if (!SvOK(sv))
                sv_setpvs(sv, "");

diff --git a/t/re/substr.t b/t/re/substr.t
index b48cb8f..e9ea126 100644 (file)
--- a/t/re/substr.t
+++ b/t/re/substr.t
@@ -24,7 +24,7 @@ $SIG{__WARN__} = sub {
 
 BEGIN { require './test.pl'; }
 
-plan(356);
+plan(358);
 
 run_tests() unless caller;
 
@@ -748,3 +748,17 @@ ok eval {
 
     is($result_3363, "best", "ref-to-substr retains lvalue-ness under recursion [perl #3363]");
 }
+
+{
+    use utf8;
+    use open qw( :utf8 :std );
+    no warnings 'once';
+
+    my $t = "";
+    substr $t, 0, 0, *ワルド;
+    is($t, "*main::ワルド", "substr works on UTF-8 globs");
+
+    $t = "The World!";
+    substr $t, 0, 9, *ザ::ワルド;
+    is($t, "*ザ::ワルド!", "substr works on a UTF-8 glob + stash");
+}