Integrate change #9197 from maintperl to mainline.

more thorough cleaning of arenas.

p4raw-link: @9197 on //depot/maint-5.6/perl: ec3d44d040803cac937295d8f4740e6a36ba30fb

p4raw-id: //depot/perl@9201
p4raw-integrated: from //depot/maint-5.6/perl@9200 'merge in'
	t/op/sort.t (@7895..) perl.c (@9064..) sv.c (@9108..) embed.pl
	proto.h (@9154..)

diff --git a/embed.pl b/embed.pl
index bd46b1c..9557a2b 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -2011,7 +2011,7 @@ Apd       |void   |sv_catpv       |SV* sv|const char* ptr
 Apd    |void   |sv_catpvn      |SV* sv|const char* ptr|STRLEN len
 Apd    |void   |sv_catsv       |SV* dsv|SV* ssv
 Apd    |void   |sv_chop        |SV* sv|char* ptr
-p      |void   |sv_clean_all
+p      |I32    |sv_clean_all
 p      |void   |sv_clean_objs
 Apd    |void   |sv_clear       |SV* sv
 Apd    |I32    |sv_cmp         |SV* sv1|SV* sv2
@@ -2493,7 +2493,7 @@ s |void   |del_xpvbm      |XPVBM* p
 s      |void   |del_xrv        |XRV* p
 s      |void   |sv_unglob      |SV* sv
 s      |void   |not_a_number   |SV *sv
-s      |void   |visit          |SVFUNC_t f
+s      |I32    |visit          |SVFUNC_t f
 s      |void   |sv_add_backref |SV *tsv|SV *sv
 s      |void   |sv_del_backref |SV *sv
 #  if defined(DEBUGGING)

diff --git a/perl.c b/perl.c
index 3e999c4..bfaafd1 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -300,7 +300,6 @@ void
 perl_destruct(pTHXx)
 {
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
-    I32 last_sv_count;
     HV *hv;
 #ifdef USE_THREADS
     Thread t;
@@ -663,13 +662,13 @@ perl_destruct(pTHXx)
     }
 
     /* Now absolutely destruct everything, somehow or other, loops or no. */
-    last_sv_count = 0;
     SvFLAGS(PL_fdpid) |= SVTYPEMASK;           /* don't clean out pid table now */
     SvFLAGS(PL_strtab) |= SVTYPEMASK;          /* don't clean out strtab now */
-    while (PL_sv_count != 0 && PL_sv_count != last_sv_count) {
-       last_sv_count = PL_sv_count;
-       sv_clean_all();
-    }
+
+    /* the 2 is for PL_fdpid and PL_strtab */
+    while (PL_sv_count > 2 && sv_clean_all())
+       ;
+
     SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
     SvFLAGS(PL_fdpid) |= SVt_PVAV;
     SvFLAGS(PL_strtab) &= ~SVTYPEMASK;

diff --git a/proto.h b/proto.h
index 1201e64..3e3a5d2 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -736,7 +736,7 @@ PERL_CALLCONV void  Perl_sv_catpv(pTHX_ SV* sv, const char* ptr);
 PERL_CALLCONV void     Perl_sv_catpvn(pTHX_ SV* sv, const char* ptr, STRLEN len);
 PERL_CALLCONV void     Perl_sv_catsv(pTHX_ SV* dsv, SV* ssv);
 PERL_CALLCONV void     Perl_sv_chop(pTHX_ SV* sv, char* ptr);
-PERL_CALLCONV void     Perl_sv_clean_all(pTHX);
+PERL_CALLCONV I32      Perl_sv_clean_all(pTHX);
 PERL_CALLCONV void     Perl_sv_clean_objs(pTHX);
 PERL_CALLCONV void     Perl_sv_clear(pTHX_ SV* sv);
 PERL_CALLCONV I32      Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2);
@@ -1219,7 +1219,7 @@ STATIC void       S_del_xpvbm(pTHX_ XPVBM* p);
 STATIC void    S_del_xrv(pTHX_ XRV* p);
 STATIC void    S_sv_unglob(pTHX_ SV* sv);
 STATIC void    S_not_a_number(pTHX_ SV *sv);
-STATIC void    S_visit(pTHX_ SVFUNC_t f);
+STATIC I32     S_visit(pTHX_ SVFUNC_t f);
 STATIC void    S_sv_add_backref(pTHX_ SV *tsv, SV *sv);
 STATIC void    S_sv_del_backref(pTHX_ SV *sv);
 #  if defined(DEBUGGING)

diff --git a/sv.c b/sv.c
index 18c5ac9..d08c378 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -147,20 +147,24 @@ S_more_sv(pTHX)
     return sv;
 }
 
-STATIC void
+STATIC I32
 S_visit(pTHX_ SVFUNC_t f)
 {
     SV* sva;
     SV* sv;
     register SV* svend;
+    I32 visited = 0;
 
     for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
        svend = &sva[SvREFCNT(sva)];
        for (sv = sva + 1; sv < svend; ++sv) {
-           if (SvTYPE(sv) != SVTYPEMASK)
+           if (SvTYPE(sv) != SVTYPEMASK) {
                (FCALL)(aTHXo_ sv);
+               ++visited;
+           }
        }
     }
+    return visited;
 }
 
 void
@@ -181,12 +185,14 @@ Perl_sv_clean_objs(pTHX)
     PL_in_clean_objs = FALSE;
 }
 
-void
+I32
 Perl_sv_clean_all(pTHX)
 {
+    I32 cleaned;
     PL_in_clean_all = TRUE;
-    visit(do_clean_all);
+    cleaned = visit(do_clean_all);
     PL_in_clean_all = FALSE;
+    return cleaned;
 }
 
 void

diff --git a/t/op/sort.t b/t/op/sort.t
index c1dfb63..2a86b38 100755 (executable)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,12 +7,6 @@ BEGIN {
 use warnings;
 print "1..58\n";
 
-# XXX known to leak scalars
-{
-  no warnings 'uninitialized';
-  $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
-}
-
 # these shouldn't hang
 {
     no warnings;