Skip Menu |
 

This queue is for tickets about the Tcl CPAN distribution.

Report information
The Basics
Id: 125577
Status: resolved
Priority: 0/
Queue: Tcl

People
Owner: Nobody in particular
Requestors: huck [...] finn.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: 1.16



Subject: Memory loss : the perl memory for a sub {...} never gets freed.
Date: Wed, 13 Jun 2018 15:54:46 -0500
To: bug-Tcl [...] rt.cpan.org
From: huck <huck [...] finn.com>
Download (untitled) / with headers
text/plain 2.8k
Ah onions in working on https://rt.cpan.org/Public/Bug/Display.html?id=125472 i discovered another problem: the perl memory for a sub {...} never gets freed. Rather than lump it into that problem i decided id make it its own report if you run the following use Tcl; use strict; use warnings; sub test_use { my $use=shift; my $useok=0; my $bad=''; eval { $useok =eval $use.';1'; unless ($useok) { $bad=$use; } }; return $bad; } BEGIN { my $use_bad=''; $use_bad.=test_use ('use Devel::Peek qw( SvREFCNT Dump)'); $use_bad.=test_use ('use Devel::Refcount qw( refcount )'); # $use_bad.=test_use ('use xxx;'); $use_bad.=test_use ('use yxxx;'); if ($use_bad) { print "1..0 # skip because: not installed $use_bad \n"; exit; }; } $| = 1; print "1..1\n"; my $inter=Tcl->new(); my @queue; my $sub; $sub=sub{ return unless (scalar(@queue)); my $line =shift @queue; return unless (scalar(@queue)); $inter->call('after',300,$sub); }; my @ctpre=refcts($sub); print '0 '.join(' ',@ctpre)."\n"; my @ctpost; for my $run (1..9) { for my $ii (1..4) {push @queue,'ok '.$ii; } $inter->call('after',50,$sub); flush_afters($inter); if ($Tcl::VERSION eq '1.02') { # have to kinda cheat and do it by hand in 1.02 # it didnt have code cleaup at all my $tclname='::perl::'.$sub; $inter->delete_ref($tclname); } @ctpost=refcts($sub); print "$run ".join(' ',@ctpost)."\n"; } if ($ctpre[0]==$ctpost[0] && $ctpre[1]==$ctpost[1]) { print "ok 1 - refcts \n";} else { unless ($ctpre[0] == $ctpost[0]) { print STDERR "SvREFCNT $ctpre[0]!=$ctpost[0]\n"; } unless ($ctpre[1] == $ctpost[1]) { print STDERR "refcount $ctpre[1]!=$ctpost[1]\n"; } print "not ok 1 - refcts \n"; } exit; sub refcts { # printf "SvREFCNT=%d refcount=%d\n",SvREFCNT( $_[0] ), refcount( $_[0]) ; return (SvREFCNT( $_[0] ), refcount( $_[0])); } sub flush_afters{ my $inter=shift; my $ct=0; while(1) { # wait for afters to finish my $info0=insure_ptrarray($inter,'after', 'info'); last unless (scalar(@$info0)); $inter->icall('after', 1000, 'set var fafafa'); #print " $inter $ct\n"; $ct++; $inter->icall('vwait', 'var'); # will wait for 1 seconds } } sub insure_ptrarray{ my $inter=shift; my $list = $inter->icall(@_); if (ref($list) ne 'Tcl::List') { # v1.02 $list=[split(' ',$list)]; } return $list; } you find that it just reports an ever increasing refcount value. this is bad. Even V1.02 is affected. Ive been working with git (im an old CVSer still) and i think i should be able to submit a gif-pull to you to fix this. while it should work without it, adding the following is helpful git tag -a 1.02 3f5eb527e1ba3b883c2ba197e4bdaf28d940f389 -m "Release 1.02" Thanks for all you do for us!!!
Subject: Re: [rt.cpan.org #125577] AutoReply: Memory loss : the perl memory for a sub {...} never gets freed.
Date: Wed, 13 Jun 2018 16:13:58 -0500
To: bug-Tcl [...] rt.cpan.org
From: huck <huck [...] finn.com>
Download (untitled) / with headers
text/plain 639b
The fix is as follows in the patch below why they did the "double tap"(AV *av = (AV *) SvREFCNT_inc((SV *) newAV());) in Tcl_CreateCommand ... i dunno, ive been trying to figure out why but i cannot. So my fix is to undouble tap it. As far as i can tell Tcl_PerlCallDeleteProc is only called within Tcl to release a perl into Tcl command binding, so that change should not effect anything in perl but to allow the memory at av to be garbage collected by perl. If anyone can educate me further about this it would be appreciated. Again, i will supply the patch as a git-pull request soon, this is just for demonstration purposes.
Download Tcl.xs.v102.patch
text/x-diff 286b

Message body is not shown because sender requested not to inline it.

Subject: Re: [rt.cpan.org #125577] Memory loss : the perl memory for a sub {...} never gets freed.
Date: Thu, 14 Jun 2018 22:29:30 -0500
To: bug-Tcl [...] rt.cpan.org
From: huck <huck [...] finn.com>
Download (untitled) / with headers
text/plain 460b
Ok i think im ready to have a go at it. still new at git, so when i talked about a git-pull before this is what i meant Enclosed is a parch file generated by git format-patch --stdout -1 > ~/cvs/pmlib-linkpatch/memloss1.02.patch i am able to apply it via git am ~/cvs/pmlib-linkpatch/memloss1.02.patch This should fix the memory loss problem. It even fixes it at v1.02 ( see https://rt.cpan.org/Public/Bug/Display.html?id=125472 for more about this)
Download memloss1.02.patch
text/x-diff 3.5k

Message body is not shown because sender requested not to inline it.

If your goal is to make a pull request to the Tcl.pm git repository (the one on GitHub), that's something that has to be done at least partly from a web browser; it can't be done completely from the command line. You have to fork the repository on GitHub, and have the clone on your computer know of your fork as a remote; then you can push your commit to your fork, and open a pull request from a browser.

This seems to be a good overview of the process (see steps "Creating a fork", "Doing your work", and "Submitting a pull request"): https://gist.github.com/Chaser324/ce0505fbed06b947d962


Or the official help: https://help.github.com/articles/fork-a-repo/ and https://help.github.com/articles/creating-a-pull-request-from-a-fork/

Or, if you'd like, someone can apply the patch and/or open a PR on your behalf (you still get credit for authoring the work in the commit).

Hope this helps
CC: tcltk [...] perl.org
Subject: Re: [rt.cpan.org #125577] Memory loss : the perl memory for a sub {...} never gets freed.
Date: Tue, 07 Aug 2018 02:42:43 -0500
To: bug-Tcl [...] rt.cpan.org
From: huck <huck [...] finn.com>
Download (untitled) / with headers
text/plain 3.2k
At 01:23 AM 8/7/2018, you wrote: Show quoted text
><URL: https://rt.cpan.org/Ticket/Display.html?id=125577 > > >If your goal is to make a pull request to the Tcl.pm git repository >(the one on >GitHub), that's something that has to be done at least partly from a web >browser; it can't be done completely from the command line. You have to fork >the repository on GitHub, and have the clone on your computer know >of your fork >as a remote; then you can push your commit to your fork, and open a pull >request from a browser. > >This seems to be a good overview of the process (see steps "Creating a fork", >"Doing your work", and "Submitting a pull request"): >https://gist.github.com/Chaser324/ce0505fbed06b947d962 > >Or the official help: https://help.github.com/articles/fork-a-repo/ and >https://help.github.com/articles/creating-a-pull-request-from-a-fork/ > >Or, if you'd like, someone can apply the patch and/or open a PR on your behalf >(you still get credit for authoring the work in the commit). > >Hope this helps
i did realize my terminology was a bit off, but i never intended to make a github account. I had always planned to do it on only my local machines and submit a patch file, but i did not realize the patch file method was not considered a "pull" at first. This is the process i used for my last patch file. # clone orig and lock down at a point # so i could restart the working copy at the same point cd ~/cvs/gits/github rm -rf ~/cvs/gits/github/tcl.pm git clone https://github.com/gisle/tcl.pm.git cd ~/cvs/gits/github/tcl.pm git checkout origin # make working copy cd ~/cvs/gits/tcl-tk rm -rf ~/cvs/gits/tcl-tk/tcl.pm git clone "file:///home/huck/cvs/gits/github/tcl.pm" cd ~/cvs/gits/tcl-tk/tcl.pm git checkout -b doc1.16 e926aa6ea07298dbc1f1dda94c5943ecc5eda4ab ### make changes vi Tcl.pm # test changes perl Makefile.PL make make test # lock down changes git commit -m 'typo fix and rname/current_r to descrname' Tcl.pm # apply to main branch git checkout master git merge -m 'doc/typo fix and rname/current_r to descrname' doc1.16 perl Makefile.PL make make test # make patch git format-patch --stdout -1 > ~/cvs/pmlib-linkpatch/doc1.16.patch cvs commit -m '' doc1.16.patch # test patch against newest master cd ~/cvs/gits/github rm -rf ~/cvs/gits/github/strp-tcl git clone https://github.com/gisle/tcl.pm.git strp-tcl cd ~/cvs/gits/github/strp-tcl git checkout master git am ~/cvs/pmlib-linkpatch/doc1.16.patch perl Makefile.PL make make test I ran the "test patch" procedure on ubuntu 12.04, 14.04, 16.04 and 18.04 boxes just to make sure. for my first patches i tested via a more complicated testing procedure shown at https://rt.cpan.org/Public/Bug/Display.html?id=125472#txn-1791081 but while it showed the added branches in gitk, the result to the master line was the same as just running the 'git am' commands against the master. Thank you for the pointers but by the time i had submitted the patches i had already digested all that material and more and realized that submitting the patch files was not considered a pull, but like i opened with i never had any thought of opening a online git account anywhere, nor did i ever plan on making my repository net accessible. At the beginning i was just confused that submitting patch files was not considered a "pull"
On Tue Aug 07 02:43:03 2018, huck@finn.com wrote:
Show quoted text

> i did realize my terminology was a bit off, but i never intended to
> make a github account. I had always planned to do it on only my local
> machines and submit a patch file, but i did not realize the patch
> file method was not considered a "pull" at first.
>
> […] At the beginning i was just confused that submitting
> patch files was not considered a "pull"

You're not wrong to think of it as a pull; the process of submitting a patch can still qualify as a "pull", as it's still a way for an upstream repo to pull in changes from your repo, in git parlance as it were. As a good example, the git request-pull command that spits out a patch-like file intended for projects that allow or require submissions via mailing list rather than e.g. GitHub. GitHub and similar sites are just re-using the "pull request" git jargon to refer to their web-side features which pull changes but in a manner beyond what plain git can do.
Actually, this was already applied back in June (717743b); the patched Tcl.xs was in release 1.06, and the test was included in release 1.16 (it needed to be added to MANIFEST).
Download (untitled) / with headers
text/plain 504b
the only thing is that I would like to have these lines of code: our $TRACE_SHOWCODE; # display generated code in call(); our $TRACE_CREATECOMMAND; # display sub creates; our $TRACE_DELETECOMMAND; # display sub deletes; $TRACE_SHOWCODE = 0 unless defined $TRACE_SHOWCODE; $TRACE_DELETECOMMAND = 0 unless defined $TRACE_DELETECOMMAND; $TRACE_CREATECOMMAND = 0 unless defined $TRACE_CREATECOMMAND; to be written as sub TRACE_SHOWCODE () {0} etc because this way it is much more efficient
Subject: Re: [rt.cpan.org #125577] Memory loss : the perl memory for a sub {...} never gets freed.
Date: Wed, 15 Aug 2018 07:01:49 -0500
To: bug-Tcl [...] rt.cpan.org
From: huck <huck [...] finn.com>
Download (untitled) / with headers
text/plain 1.9k
if those changes were made how could you then code the following? use strict; use warnings; use Tcl; $|=1; my $inter=Tcl->new(); $Tcl::TRACE_DELETECOMMAND = 1; $Tcl::TRACE_CREATECOMMAND = 1; $Tcl::TRACE_SHOWCODE = 1; my $sub=sub { print "hi\n";}; for my $ii (0..5) { $inter->call('after',200,$sub);} flush_afters($inter); $Tcl::TRACE_DELETECOMMAND = 0; for my $ii (0..5) { $inter->call('after',1200,sub {print "$ii\n";}); } flush_afters($inter); $Tcl::TRACE_DELETECOMMAND = 1; for my $ii (0..5) { $inter->call('after',1200,sub {print "$ii\n";}); sleep 1;} flush_afters($inter); for my $ii (0..5) { $inter->call('after',200,sub {print "$ii\n";}); } flush_afters($inter); $Tcl::TRACE_DELETECOMMAND = 0; for my $ii (0..5) { $inter->call('after',1200,sub {print "$ii\n";}); } flush_afters($inter); exit; sub flush_afters{ my $inter=shift; print "begin flush afters\n"; while(1) { # wait for afters to finish my $info0=insure_ptrarray($inter,'after', 'info'); last unless (scalar(@$info0)); $inter->icall('after', 300, 'set var fafafa'); $inter->icall('vwait', 'var'); # will wait for .3 seconds } print "end flush afters\n"; } # flush afters sub insure_ptrarray{ my $inter=shift; my $list = $inter->icall(@_); if (ref($list) ne 'Tcl::List') { # v1.02 $list=[split(' ',$list)]; } return $list; } At 01:48 AM 8/15/2018, you wrote: Show quoted text
><URL: https://rt.cpan.org/Ticket/Display.html?id=125577 > > >the only thing is that I would like to have these lines of code: > >our $TRACE_SHOWCODE; # display generated code in call(); >our $TRACE_CREATECOMMAND; # display sub creates; >our $TRACE_DELETECOMMAND; # display sub deletes; > >$TRACE_SHOWCODE = 0 unless defined $TRACE_SHOWCODE; >$TRACE_DELETECOMMAND = 0 unless defined $TRACE_DELETECOMMAND; >$TRACE_CREATECOMMAND = 0 unless defined $TRACE_CREATECOMMAND; > > >to be written as > >sub TRACE_SHOWCODE () {0} >etc >because this way it is much more efficient


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.