patch 8.1.0190: Perl refcounts are wrong

Problem:    Perl refcounts are wrong.
Solution:   Improve refcounting.  Add a test. (Damien)

diff --git a/src/if_perl.xs b/src/if_perl.xs
index 40955ebf0e69bcfed433414292014e96c52f9367..9f50a87c320c5c7294ea8334bb79b4c5536027cd 100644 (file)
--- a/src/if_perl.xs
+++ b/src/if_perl.xs
@@ -845,6 +845,14 @@ newBUFrv(SV *rv, buf_T *ptr)
     return sv_bless(rv, gv_stashpv("VIBUF", TRUE));
 }
 
+#if 0
+SV *__sv_save[1024];
+int __sv_save_ix;
+#  define D_Save_Sv(sv) do { if (__sv_save_ix < 1024) __sv_save[__sv_save_ix++] = (sv); } while (0)
+#else
+#  define D_Save_Sv(sv) NOOP
+#endif
+
 /*
  * perl_win_free
  *     Remove all references to the window to be destroyed
@@ -852,17 +860,27 @@ newBUFrv(SV *rv, buf_T *ptr)
     void
 perl_win_free(win_T *wp)
 {
-    if (wp->w_perl_private)
-       sv_setiv((SV *)wp->w_perl_private, 0);
-    return;
+    if (wp->w_perl_private && perl_interp != NULL)
+    {
+       SV *sv = (SV*)wp->w_perl_private;
+       D_Save_Sv(sv);
+       sv_setiv(sv, 0);
+       SvREFCNT_dec(sv);
+    }
+    wp->w_perl_private = NULL;
 }
 
     void
 perl_buf_free(buf_T *bp)
 {
-    if (bp->b_perl_private)
-       sv_setiv((SV *)bp->b_perl_private, 0);
-    return;
+    if (bp->b_perl_private && perl_interp != NULL)
+    {
+       SV *sv = (SV *)bp->b_perl_private;
+       D_Save_Sv(sv);
+       sv_setiv(sv, 0);
+       SvREFCNT_dec(sv);
+    }
+    bp->b_perl_private = NULL;
 }
 
 #ifndef PROTO
@@ -885,12 +903,19 @@ I32 cur_val(IV iv, SV *sv)
 # endif
 {
     SV *rv;
+
     if (iv == 0)
        rv = newWINrv(newSV(0), curwin);
     else
        rv = newBUFrv(newSV(0), curbuf);
-    sv_setsv(sv, rv);
-    SvREFCNT_dec(SvRV(rv));
+
+    if (SvRV(sv) == SvRV(rv))
+       SvREFCNT_dec(SvRV(rv));
+    else /* XXX: Not sure if the `else` condition are right
+         * Test_SvREFCNT() pass in all case.
+         */
+       sv_setsv(sv, rv);
+
     return 0;
 }
 #endif /* !PROTO */
@@ -1539,7 +1564,7 @@ Buffers(...)
        else
        {
            FOR_ALL_BUFFERS(vimbuf)
-               XPUSHs(newBUFrv(newSV(0), vimbuf));
+               XPUSHs(sv_2mortal(newBUFrv(newSV(0), vimbuf)));
        }
     }
     else
@@ -1564,7 +1589,7 @@ Buffers(...)
            {
                vimbuf = buflist_findnr(b);
                if (vimbuf)
-                   XPUSHs(newBUFrv(newSV(0), vimbuf));
+                   XPUSHs(sv_2mortal(newBUFrv(newSV(0), vimbuf)));
            }
        }
     }
@@ -1584,7 +1609,7 @@ Windows(...)
        else
        {
            FOR_ALL_WINDOWS(vimwin)
-               XPUSHs(newWINrv(newSV(0), vimwin));
+               XPUSHs(sv_2mortal(newWINrv(newSV(0), vimwin)));
        }
     }
     else
@@ -1594,7 +1619,7 @@ Windows(...)
            w = (int) SvIV(ST(i));
            vimwin = win_find_nr(w);
            if (vimwin)
-               XPUSHs(newWINrv(newSV(0), vimwin));
+               XPUSHs(sv_2mortal(newWINrv(newSV(0), vimwin)));
        }
     }
 

diff --git a/src/testdir/test_perl.vim b/src/testdir/test_perl.vim
index 6ef17ad8bbaad1fac618ce02a9067b2e65f85fdf..4934780a620292e4692227e0fbf915e3fac0454d 100644 (file)
--- a/src/testdir/test_perl.vim
+++ b/src/testdir/test_perl.vim
@@ -219,20 +219,42 @@ EOF
   call assert_equal(['&VIM::Msg', 'STDOUT', 'STDERR'], split(l:out, "\n"))
 endfunc
 
-func Test_SvREFCNT()
+" Run first to get a clean namespace
+func Test_000_SvREFCNT()
+  for i in range(10)
+    exec 'new X'.i
+  endfor
   new t
   perl <<--perl
+#line 5 "Test_000_SvREFCNT()"
   my ($b, $w);
-  $b = $curbuf for 0 .. 10;
-  $w = $curwin for 0 .. 10;
+
+  $b = $curbuf      for 0 .. 100;
+  $w = $curwin      for 0 .. 100;
+  () = VIM::Buffers for 0 .. 100;
+  () = VIM::Windows for 0 .. 100;
+
   VIM::DoCommand('bw! t');
   if (exists &Internals::SvREFCNT) {
       my $cb = Internals::SvREFCNT($$b);
       my $cw = Internals::SvREFCNT($$w);
-      VIM::Eval("assert_equal(2, $cb)");
-      VIM::Eval("assert_equal(2, $cw)");
+      VIM::Eval("assert_equal(2, $cb, 'T1')");
+      VIM::Eval("assert_equal(2, $cw, 'T2')");
+      foreach ( VIM::Buffers, VIM::Windows ) {
+         my $c = Internals::SvREFCNT($_);
+         VIM::Eval("assert_equal(2, $c, 'T3')");
+         $c = Internals::SvREFCNT($$_);
+         # Why only one ref?
+         # Look wrong but work.  Maybe not portable...
+         VIM::Eval("assert_equal(1, $c, 'T4')");
+      }
+      $cb = Internals::SvREFCNT($$curbuf);
+      $cw = Internals::SvREFCNT($$curwin);
+      VIM::Eval("assert_equal(3, $cb, 'T5')");
+      VIM::Eval("assert_equal(3, $cw, 'T6')");
   }
   VIM::Eval("assert_false($$b)");
   VIM::Eval("assert_false($$w)");
 --perl
+  %bw!
 endfunc

diff --git a/src/version.c b/src/version.c
index c48804cc73a408a73ac86f1748e5808ca249062b..ffc651dc5ec5138cfc764a0c338e4373647efad1 100644 (file)
--- a/src/version.c
+++ b/src/version.c
@@ -789,6 +789,8 @@ static char *(features[]) =
 
 static int included_patches[] =
 {   /* Add new patch number below this line */
+/**/
+    190,
 /**/
     189,
 /**/