[svk-commit] r2523 - in trunk: t

nobody at bestpractical.com nobody at bestpractical.com
Sun Aug 5 06:05:40 EDT 2007


Author: matthewd
Date: Sun Aug  5 06:05:37 2007
New Revision: 2523

Added:
   trunk/t/80memory.t
Modified:
   trunk/lib/SVK/Editor/Merge.pm

Log:
Tweaked pool handling during merges of deletes and adds, and added tests
to reflect the reduced memory consumption. Merging a bulk addition now
leaks substantially less, and merging a bulk delete doesn't appear to
leak at all.

Modified: trunk/lib/SVK/Editor/Merge.pm
==============================================================================
--- trunk/lib/SVK/Editor/Merge.pm	(original)
+++ trunk/lib/SVK/Editor/Merge.pm	Sun Aug  5 06:05:37 2007
@@ -251,9 +251,10 @@
     return unless defined $pdir;
     my $pool = pop @arg;
     # a replaced node shouldn't be checked with cb_exist
+    my $spool = SVN::Pool->new_default($pool);
     my $touched = $self->{notify}->node_status($path);
     if (!$self->{added}{$pdir} && !$touched &&
-	(my $kind = $self->inspector->exist($path, $pool))) {
+	(my $kind = $self->inspector->exist($path, $spool))) {
 	unless ($kind == $SVN::Node::file) {
 	    $self->{notify}->flush ($path) ;
 	    return undef;
@@ -278,7 +279,9 @@
 	}
 	$self->{storage_baton}{$path} =
 	    $self->{storage}->add_file ($path, $self->{storage_baton}{$pdir}, @arg, $pool);
-	$pool->default if $pool && $pool->can ('default');
+	# XXX: Why was this here? All tests pass without it.
+	#$pool->default if $pool && $pool->can ('default');
+
 	# XXX: fpool is used for testing if the file is open rather than add,
 	# so use another field to hold it.
 	$self->{info}{$path}{hold_pool} = $pool;
@@ -740,7 +743,6 @@
 # Note that empty hash means don't delete - conflict.
 sub _check_delete_conflict {
     my ($self, $path, $rpath, $kind, $pdir, $pool) = @_;
-    $pool->default;
 
     my $localkind = $self->inspector->exist ($path, $pool);
 
@@ -778,13 +780,13 @@
                 $torm->{$name} = undef;
 	    }
             else {
-                $torm->{$name} = $self->_check_delete_conflict ($cpath, $crpath, $entry->kind, $path, SVN::Pool->new($pool));
+                $torm->{$name} = $self->_check_delete_conflict ($cpath, $crpath, $entry->kind, $path, SVN::Pool->new_default($pool));
             }
             delete $dirmodified->{$name};
 	}
 	else { # dir or unmodified file
             $torm->{$name} = $self->_check_delete_conflict
-                ($cpath, $crpath, $entry->kind, $path, SVN::Pool->new($pool));
+                ($cpath, $crpath, $entry->kind, $path, SVN::Pool->new_default($pool));
 	}
     }
 
@@ -792,7 +794,7 @@
         local $self->{tree_conflict} = 1;
         my ($cpath, $crpath) = ("$path/$node", "$rpath/$node");
         my $kind = $self->{base_root}->check_path ($crpath);
-        $torm->{$node} = $self->_check_delete_conflict ($cpath, $crpath, $kind, $path, SVN::Pool->new($pool));
+        $torm->{$node} = $self->_check_delete_conflict ($cpath, $crpath, $kind, $path, SVN::Pool->new_default($pool));
     }
 
     $self->{storage}->close_directory ($baton, $pool);
@@ -830,7 +832,7 @@
     for (sort keys %$torm) {
 	my $cpath = "$path/$_";
         # check that out
-	my $status = $self->_partial_delete ($torm->{$_}, $cpath, $baton, SVN::Pool->new ($pool), 1);
+	my $status = $self->_partial_delete ($torm->{$_}, $cpath, $baton, SVN::Pool->new_default($pool), 1);
         push @children_stats, [$cpath, $status];
         $skip_children = 0  unless $status eq 'D';
         $summary = 'C' if $status eq 'C';
@@ -870,10 +872,9 @@
 }
 
 sub delete_entry {
-    my ($self, $path, $revision, $pdir, @arg) = @_;
+    my ($self, $path, $revision, $pdir, $pool) = @_;
     no warnings 'uninitialized';
-    my $pool = $arg[-1];
-    $pool->default;
+    $pool = SVN::Pool->new_default($pool);
     my ($basepath, $fromrev) = $self->_resolve_base($path);
     $basepath = $path unless defined $basepath;
 
@@ -888,10 +889,10 @@
 	# XXX: this is too evil
 	local $self->{base_root} = $self->{base_root}->fs->revision_root($fromrev) if $basepath ne $path;
 	my $kind = $self->{base_root}->check_path ($rpath);
-        $torm = $self->_check_delete_conflict ($path, $rpath, $kind, $pdir, @arg);
+	$torm = $self->_check_delete_conflict ($path, $rpath, $kind, $pdir, $pool);
     }
 
-    $self->_partial_delete ($torm, $path, $self->{storage_baton}{$pdir}, @arg);
+    $self->_partial_delete ($torm, $path, $self->{storage_baton}{$pdir}, $pool);
     ++$self->{changes};
 }
 

Added: trunk/t/80memory.t
==============================================================================
--- (empty file)
+++ trunk/t/80memory.t	Sun Aug  5 06:05:37 2007
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -w
+use strict;
+BEGIN {
+  -d '/proc' or
+    eval { use BSD::Resource; } or
+    plan( skip_all => "No /proc and no BSD::Resources" );
+}
+use SVK::Test;
+plan tests => 6;
+
+my $curr_mem = sub { -1 };
+if( -d '/proc' ) {
+  $curr_mem = sub {
+    open STAT, "grep '^VmRSS' /proc/$$/status|";
+    my $ret = $1 if( <STAT> =~ /:\s*([^\s]*)/ );
+    close STAT;
+    return $ret;
+  }
+} else {
+  use BSD::Resource;
+  $curr_mem = sub {
+    my @r = BSD::Resource::getrusage();
+    return $r[2];
+  }
+}
+
+sub no_leak {
+  my ($action, $block) = @_;
+  my $before = &$curr_mem;
+  #diag("$before before $action");
+  &$block;
+  my $after = &$curr_mem;
+  #diag("$after after $action");
+  my $diff = $after - $before;
+  cmp_ok($diff, '<', $before * 0.03, "Memory use shouldn't increase during $action") and
+    $diff > 0 and diag("Memory use grew by $diff during $action");
+}
+
+our ($output, $answer);
+my ($xd, $svk) = build_test('foo');
+$svk->mkdir ('-pm', 'init src', '//mem-src/container');
+$svk->mkdir ('-m', 'init dest', '//mem-dest');
+$svk->smerge ('-Bm', 'merge init', '//mem-src', '//mem-dest');
+
+our ($copath, $corpath) = get_copath ('memory');
+
+no_leak('svk co', sub {
+  $svk->checkout ('//mem-src', $copath);
+});
+
+my $max = 350;
+my @names = (1..$max);
+
+for my $name (@names) {
+  append_file ("$copath/container/f-$name", "file $name");
+}
+
+
+TODO: {
+local $TODO = "Fix more leaks";
+
+no_leak('svk add', sub {
+  $svk->add ("$copath/container");
+});
+
+no_leak('svk ci', sub {
+  $svk->commit ('-m', 'add', "$copath/container");
+});
+
+no_leak('merge add', sub {
+  $svk->smerge ('-Bm', 'merge add', '//mem-src', '//mem-dest');
+});
+
+}
+
+no_leak('svk rm', sub {
+  $svk->delete ('-m', 'del', "//mem-src/container");
+});
+
+no_leak('merge delete', sub {
+  $svk->smerge ('-Bm', 'merge del', '//mem-src', '//mem-dest');
+});
+


More information about the svk-commit mailing list