patch 8.1.0190: Perl refcounts are wrongv8.1.0190

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

3 files changed, 66 insertions, 17 deletions

diff --git a/src/if_perl.xs b/src/if_perl.xs
index 40955ebf0..9f50a87c3 100644
--- 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 6ef17ad8b..4934780a6 100644
--- 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 c48804cc7..ffc651dc5 100644
--- a/src/version.c
+++ b/src/version.c
@@ -790,6 +790,8 @@ static char *(features[]) =
 static int included_patches[] =
 {   /* Add new patch number below this line */
 /**/
+    190,
+/**/
     189,
 /**/
     188,