Mercurial > vim
changeset 14350:142c0083b3b8 v8.1.0190
patch 8.1.0190: Perl refcounts are wrong
commit https://github.com/vim/vim/commit/18c4f1badbc96d39de5b348f268ac8d55c2b0b67
Author: Bram Moolenaar <Bram@vim.org>
Date: Mon Jul 16 17:45:38 2018 +0200
patch 8.1.0190: Perl refcounts are wrong
Problem: Perl refcounts are wrong.
Solution: Improve refcounting. Add a test. (Damien)
author | Christian Brabandt <cb@256bit.org> |
---|---|
date | Mon, 16 Jul 2018 18:00:07 +0200 |
parents | 6e065a3bad97 |
children | 2bb7539b16b0 |
files | src/if_perl.xs src/testdir/test_perl.vim src/version.c |
diffstat | 3 files changed, 66 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- 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))); } }
--- 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