[perl #61022] sub ref passed to sort causes memory leak

> 
> Summarizing the results:
> - Both issues seem resolved in bleadperl.
> - My 5.8.8 does not exhibit the REFCNT=2 that was reported for the 
two 
> sort calls. Is this a RedHat thing again?

This was not a RedHat thing.. this was a case of a not so good test 
script.

A better test script:
#!/usr/bin/perl

use strict;
use warnings;
use Devel::Peek;

my $foo;
sub s1 {
        my $var = sub { $foo++; return 1; };
        bless($var, 'main');

        my @test_array1 = sort $var (1, 2);
        my @test_array2 = sort $var (1, 2);
        Dump($var);
}
s1();

sub DESTROY {
        print "Destroy: $_[0]\n";
}
__END__

The expected output from this script is Destroy: CODE(0x........).

$ perl-5.8.8 rt-61022.pl
SV = RV(0x8172368) at 0x812cc54
  REFCNT = 1
  FLAGS = (PADBUSY,PADMY,ROK)
  RV = 0x812c180
  SV = PVCV(0x8161dd8) at 0x812c180
    REFCNT = 3
    FLAGS = (OBJECT,ANON,CLONED)
    IV = 0
    NV = 0
    STASH = 0x812c0a8   "main"
    COMP_STASH = 0x812c0a8      "main"
    START = 0x8134658 ===> 2595
    ROOT = 0x814a890
    XSUB = 0x0
    XSUBANY = 0
    GVGV::GV = 0x815efb4        "main" :: "__ANON__"
    FILE = "rt-61022.pl"
    DEPTH = 0
    FLAGS = 0x6
    OUTSIDE_SEQ = 206
    PADLIST = 0x812c294
    PADNAME = 0x812cbe8(0x8140d70) PAD = 0x812c09c(0x816da28)
       1. 0x812cc48<3> FAKE "$foo"
    OUTSIDE = 0x812cc30 (s1)
    SV = PVCV(0x813aeb8) at 0x812cc30
      REFCNT = 4
      FLAGS = ()
      IV = 0
      NV = 0
      COMP_STASH = 0x812c0a8    "main"
      START = 0x8170108 ===> 2603
      ROOT = 0x816d940
      XSUB = 0x0
      XSUBANY = 0
      GVGV::GV = 0x8178858      "main" :: "s1"
      FILE = "rt-61022.pl"
      DEPTH = 1
      FLAGS = 0x0
      OUTSIDE_SEQ = 206
      PADLIST = 0x812cc3c
      PADNAME = 0x812cc0c(0x816fff8) PAD = 0x812cc60(0x816ff38)
         1. 0x812cc54<1> (207,210) "$var"
         2. 0x8156430<1> (1,4294967295) "&"
         3. 0x81784ec<1> (208,210) "@test_array1"
         5. 0x8178828<1> (209,210) "@test_array2"
      OUTSIDE = 0x812c2a0 (MAIN)

=> REFCNT is 3 and Destroy: CODE(0x........) is not printed


$ perl-5.8.9 rt-61022.pl

SV = RV(0x8176e7c) at 0x812ec54
  REFCNT = 1
  FLAGS = (PADBUSY,PADMY,ROK)
  RV = 0x812e18c
  SV = PVCV(0x8165010) at 0x812e18c
    REFCNT = 1
    FLAGS = (OBJECT,ANON,CLONED)
    IV = 0
    NV = 0
    STASH = 0x812e0b4   "main"
    COMP_STASH = 0x812e0b4      "main"
    START = 0x8137650 ===> 2551
    ROOT = 0x8155940
    XSUB = 0x0
    XSUBANY = 0
    GVGV::GV = 0x8153f74        "main" :: "__ANON__"
    FILE = "rt-61022.pl"
    DEPTH = 0
    FLAGS = 0x6
    OUTSIDE_SEQ = 211
    PADLIST = 0x812e2ac
    PADNAME = 0x812e0a8(0x8144ca0) PAD = 0x812ebe8(0x8162d88)
       1. 0x812ec48<3> FAKE "$foo"
    OUTSIDE = 0x812ec30 (s1)
    SV = PVCV(0x813ecb0) at 0x812ec30
      REFCNT = 4
      FLAGS = ()
      IV = 0
      NV = 0
      COMP_STASH = 0x812e0b4    "main"
      START = 0x8162fb8 ===> 2559
      ROOT = 0x8162958
      XSUB = 0x0
      XSUBANY = 0
      GVGV::GV = 0x817c078      "main" :: "s1"
      FILE = "rt-61022.pl"
      DEPTH = 1
      FLAGS = 0x0
      OUTSIDE_SEQ = 211
      PADLIST = 0x812ec3c
      PADNAME = 0x812ec0c(0x81472e8) PAD = 0x812ec60(0x81557d0)
         1. 0x812ec54<1> (212,215) "$var"
         2. 0x814b2f8<1> (1,4294967295) "&"
         3. 0x817bd18<1> (213,215) "@test_array1"
         5. 0x817c048<1> (214,215) "@test_array2"
      OUTSIDE = 0x812e2b8 (MAIN)
Destroy: main=CODE(0x812e18c)

=> REFCNT is 1 and Destroy: CODE(0x........) is printed


Doing a binary search on it:

----Program----
#!/usr/bin/perl

use strict;
use warnings;

my $foo;
sub s1 {
        my $var = sub { $foo++; return 1; };
        bless($var, 'main');

        my @test_array1 = sort $var (1, 2);
        my @test_array2 = sort $var (1, 2);
}
s1();

sub DESTROY {
        my $s = $_[0];
        $s =~ s/0x[a-zA-Z0-9]+/0x......../;
        print "Destroy: $s\n";
}


----Output of .../pmvhB8j/perl-5.9.2@25952/bin/perl----

----EOF ($?='0')----
----Output of .../p2LTEwZ/perl-5.9.2@25953/bin/perl----
Destroy: main=CODE(0x........)

----EOF ($?='0')----

Change 25953: http://public.activestate.com/cgi-bin/perlbrowse/p/25953
	Subject: [PATCH] sort/multicall patch
	From: Robin Houston <robin@cpan.org>
	Date: Sat, 29 Oct 2005 21:33:07 +0100
	Message-ID: <20051029203307.GA8869@rpc142.cs.man.ac.uk>

It also includes a test case for it:

+# Sorting shouldn't increase the refcount of a sub
+sub foo {(1+$a) <=> (1+$b)}
+my $refcnt = &Internals::SvREFCNT(\&foo);
+@output = sort foo 3,7,9;
+package Foo;
+ok($refcnt, &Internals::SvREFCNT(\&foo), "sort sub refcnt");


Meaning: this bug is resolved in perl-5.8.9, perl-5.10.0 and in perl-
current.


Kind regard,

Bram

• [perl #61022] sub ref passed to sort causes memory leak by Bram via RT