[svk-commit] r3104 - branches/git-storage/lib/SVK

nobody at bestpractical.com nobody at bestpractical.com
Thu Oct 30 02:22:39 EDT 2008


Author: clsung
Date: Thu Oct 30 02:22:38 2008
New Revision: 3104

Modified:
   branches/git-storage/lib/SVK/Test.pm

Log:
- create_basic_git_tree & build_git_test
  - will use ENV{GITREPOS} to control the flow later

Modified: branches/git-storage/lib/SVK/Test.pm
==============================================================================
--- branches/git-storage/lib/SVK/Test.pm	(original)
+++ branches/git-storage/lib/SVK/Test.pm	Thu Oct 30 02:22:38 2008
@@ -60,13 +60,13 @@
 
 use SVK::Logger;
 
-our @EXPORT = qw(plan_svm new_repos build_test build_floating_test
+our @EXPORT = qw(plan_svm new_repos build_test build_git_test build_floating_test
 		 get_copath append_file overwrite_file
 		 overwrite_file_raw is_file_content
 		 is_file_content_raw _do_run is_output
 		 is_sorted_output is_deeply_like is_output_like
 		 is_output_unlike is_ancestor status_native status
-		 get_editor create_basic_tree waste_rev
+		 get_editor create_basic_tree create_basic_git_tree waste_rev
 		 tree_from_fsroot tree_from_xdroot __ _x not_x _l
 		 not_l uri set_editor replace_file glob_mime_samples
 		 create_mime_samples chmod_probably_useless
@@ -100,8 +100,10 @@
 use File::Path;
 use File::Temp;
 use SVK::Util qw( dirname catdir tmpdir can_run abs_path $SEP $EOL IS_WIN32 HAS_SVN_MIRROR );
+use Cwd;
 require Storable;
 use SVK::Path::Checkout;
+use File::Copy::Recursive qw(dircopy);
 
 # Fake standard input
 our $answer = [];
@@ -197,6 +199,21 @@
     return $repospath;
 }
 
+sub new_repos_git {
+    my $repospath = catdir(tmpdir(), "svk-git-$$");
+    my $reposbase = $repospath;
+    my $repos;
+    my $i = 0;
+    while (-e $repospath) {
+	$repospath = $reposbase . '-'. (++$i);
+    }
+    my $pool = SVN::Pool->new_default;
+    #chdir catdir(abs_path(dirname(__FILE__)), '..' );
+    mkdir $repospath;
+    my $response = `chdir $repospath; git init`;
+    return $repospath."/.git";
+}
+
 sub build_test {
     my (@depot) = @_;
 
@@ -208,6 +225,18 @@
     return ($xd, $svk);
 }
 
+# XXX: redundant code of build_test, should have a better way
+sub build_git_test {
+    my (@depot) = @_;
+
+    my $depotmap = {map {$_ => (new_repos_git())[0]} '', at depot};
+    my $xd = SVK::XD->new (depotmap => $depotmap,
+			   svkpath => $depotmap->{''});
+    my $svk = SVK->new (xd => $xd, $ENV{DEBUG_INTERACTIVE} ? () : (output => \$output));
+    push @TOCLEAN, [$xd, $svk];
+    return ($xd, $svk);
+}
+
 sub build_floating_test {
     my ($directory) = @_;
 
@@ -249,6 +278,7 @@
     for my $depotname (sort keys %{$xd->{depotmap}}) {
 	my $pool = SVN::Pool->new_default;
         my $depot = eval { $xd->find_depot($depotname) } or next;
+        next unless $depot->repos;
         my @txns = @{ $depot->repos->fs->list_transactions };
         if (@txns) {
             my $how_many = @txns;
@@ -512,6 +542,75 @@
     return $tree;
 }
 
+sub create_basic_git_tree {
+    my ($xd, $depotpath) = @_;
+    my $pool = SVN::Pool->new_default;
+    my ($depot, $path) = $xd->find_depotpath($depotpath);
+
+    local $/ = $EOL;
+    my $repospath = $depot->repospath;
+    my $response;
+    my $initial_cwd = getcwd;
+    $repospath =~ s{/\.git/?$}{};
+
+    overwrite_file($repospath.'/me',
+			"first line in me$/2nd line in me$/");
+    mkdir ($repospath.'/A');
+    mkdir ($repospath.'/A/P');
+    overwrite_file($repospath.'/A/be',
+			"\$Rev\$ \$Revision\$$/\$FileRev\$$/first line in be$/2nd line in be$/");
+    #$edit->change_file_prop ('/A/be', 'svn:keywords', 'Rev URL Revision FileRev');
+    overwrite_file($repospath.'/A/P/pe',
+			"first line in pe$/2nd line in pe$/");
+    mkdir ($repospath.'/B');
+    mkdir ($repospath.'/C');
+    mkdir ($repospath.'/A/Q');
+    #$edit->change_dir_prop ('/A/Q', 'foo', 'prop on A/Q');
+    overwrite_file($repospath.'/A/Q/qu',
+			"first line in qu$/2nd line in qu$/");
+    overwrite_file($repospath.'/A/Q/qz',
+			"first line in qz$/2nd line in qz$/");
+    mkdir ($repospath.'/C/R');
+    chdir ($repospath);
+    $response = `git add .`;
+    $response = `git commit -m "- initial basic_tree"`;
+    my $tree = { child => { me => {},
+			    A => { child => { be => {},
+					      P => { child => {pe => {},
+							      }},
+					      Q => { child => {qu => {},
+							       ez => {},
+							      }},
+					    }},
+			    B => {},
+			    C => { child => { R => { child => {}}}}
+			  }};
+    # XXX: skip all the revision work here.
+    overwrite_file('me',
+                        "first line in me$/2nd line in me - mod$/");
+    overwrite_file('B/fe',
+			"file fe added later$/");
+    $response = `git add .`;
+    $response = `git rm -r A/P`;
+    $response = `git commit -m "- add one file and remove one dir and modify one file"`;
+    dircopy('A', 'B/S');
+    $response = `git add .`;
+    mkdir ('D');
+    overwrite_file('D/de',
+			"file de added later$/");
+    $response = `git commit -m "- copy one dir and add one file"`;
+
+    $tree->{child}{B}{child}{fe} = {};
+    # XXX: have to clone this...
+    %{$tree->{child}{B}{child}{S}} = (child => {%{$tree->{child}{A}{child}}},
+				      history => '/A:1'); # XXX: no history indeed here (git)
+    delete $tree->{child}{A}{child}{P};
+    $tree->{child}{D}{child}{de} = {};
+    chdir $initial_cwd;
+
+    return $tree;
+}
+
 sub add_prop_to_basic_tree {
     my ($xd, $depotpath, $props) = @_;
     my $pool = SVN::Pool->new_default;


More information about the svk-commit mailing list