r29164 - in /trunk/libgit-fastexport-perl: Changes MANIFEST META.yml debian/changelog lib/Git/FastExport.pm lib/Git/FastExport/ script/git-stitch-repo t/00load.t t/01new.t t/10fast-export.t t/20stitch.t t/30stitch-repo.t t/Utils.pm
efaistos-guest at users.alioth.debian.org
efaistos-guest at users.alioth.debian.org
Sun Jan 4 04:52:53 UTC 2009
Author: efaistos-guest
Date: Sun Jan 4 04:52:50 2009
New Revision: 29164
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=29164
Log:
New upstream version
Added:
trunk/libgit-fastexport-perl/lib/Git/FastExport/
- copied from r29163, branches/upstream/libgit-fastexport-perl/current/lib/Git/FastExport/
trunk/libgit-fastexport-perl/t/20stitch.t
- copied unchanged from r29163, branches/upstream/libgit-fastexport-perl/current/t/20stitch.t
Modified:
trunk/libgit-fastexport-perl/Changes
trunk/libgit-fastexport-perl/MANIFEST
trunk/libgit-fastexport-perl/META.yml
trunk/libgit-fastexport-perl/debian/changelog
trunk/libgit-fastexport-perl/lib/Git/FastExport.pm
trunk/libgit-fastexport-perl/script/git-stitch-repo
trunk/libgit-fastexport-perl/t/00load.t
trunk/libgit-fastexport-perl/t/01new.t
trunk/libgit-fastexport-perl/t/10fast-export.t
trunk/libgit-fastexport-perl/t/30stitch-repo.t
trunk/libgit-fastexport-perl/t/Utils.pm
Modified: trunk/libgit-fastexport-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/Changes?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/Changes (original)
+++ trunk/libgit-fastexport-perl/Changes Sun Jan 4 04:52:50 2009
@@ -1,4 +1,36 @@
Revision history for Perl extension Git::FastExport
+
+0.07 Sat Jan 3 06:35:52 CET 2009
+ [ENHANCEMENTS]
+ - moved the stitching algorithm in its own module:
+ Git::Fast:Export::Stitch
+ - git-stitch-repo is now a thin wrapper around it
+ [DOCUMENTATION]
+ - the stitching algorithm is documented in Git::FastExport::Stitch
+ - the use cases are documented in git-stitch-repo
+ [TESTS]
+ - fixed the test repositories code
+ - added tests involving stitching 3-way merges
+
+0.06 Sat Dec 20 00:07:44 CET 2008
+ [ENHANCEMENTS]
+ - git-stitch-repo: greatly improved the algorithm for finding
+ a suitable commit to attach to, avoiding inconsistencies:
+ git-stitch-repo can now stitch non-linear repositories
+ in a consistent way
+ - git-stitch-repo: added an option to change the attachment
+ commit selection algorithm
+ [DOCUMENTATION]
+ - documentation improvements on git-stitch-repo, with a lot
+ more ascii graphs
+
+0.05 Sun Oct 5 01:22:53 CEST 2008
+ [ENHANCEMENTS]
+ - made Git::FastExport::Block an independent module
+ [TESTS]
+ - t/30stitch-repo.t now caches the source repositories used in
+ the tests. This speed up considerably this test script after
+ the first run (from 2 minutes to 2 seconds)
0.04 Wed Aug 20 22:04:30 CEST 2008
[ENHANCEMENTS]
Modified: trunk/libgit-fastexport-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/MANIFEST?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/MANIFEST (original)
+++ trunk/libgit-fastexport-perl/MANIFEST Sun Jan 4 04:52:50 2009
@@ -1,6 +1,8 @@
Build.PL
Changes
lib/Git/FastExport.pm
+lib/Git/FastExport/Block.pm
+lib/Git/FastExport/Stitch.pm
Makefile.PL
MANIFEST This list of files
META.yml
@@ -9,6 +11,7 @@
t/00load.t
t/01new.t
t/10fast-export.t
+t/20stitch.t
t/30stitch-repo.t
t/fast-export
t/pod-coverage.t
Modified: trunk/libgit-fastexport-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/META.yml?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/META.yml (original)
+++ trunk/libgit-fastexport-perl/META.yml Sun Jan 4 04:52:50 2009
@@ -1,6 +1,6 @@
---
name: Git-FastExport
-version: 0.04
+version: 0.07
author: []
abstract: A module to parse the output of git-fast-export
license: perl
@@ -11,9 +11,13 @@
provides:
Git::FastExport:
file: lib/Git/FastExport.pm
- version: 0.04
+ version: 0.07
Git::FastExport::Block:
- file: lib/Git/FastExport.pm
+ file: lib/Git/FastExport/Block.pm
+ version: 0.07
+ Git::FastExport::Stitch:
+ file: lib/Git/FastExport/Stitch.pm
+ version: 0.07
generated_by: Module::Build version 0.2808
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
Modified: trunk/libgit-fastexport-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/debian/changelog?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/debian/changelog (original)
+++ trunk/libgit-fastexport-perl/debian/changelog Sun Jan 4 04:52:50 2009
@@ -1,4 +1,10 @@
-libgit-fastexport-perl (0.04-1) UNRELEASED; urgency=low
+libgit-fastexport-perl (0.07-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Edi Stojicevic <efaistos at swoosh> Sun, 04 Jan 2009 04:41:22 +0000
+
+libgit-fastexport-perl (0.04-1) unstable; urgency=low
* Initial Release. (Closes: #489145)
Modified: trunk/libgit-fastexport-perl/lib/Git/FastExport.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/lib/Git/FastExport.pm?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/lib/Git/FastExport.pm (original)
+++ trunk/libgit-fastexport-perl/lib/Git/FastExport.pm Sun Jan 4 04:52:50 2009
@@ -2,18 +2,27 @@
use strict;
use warnings;
use Carp;
-use Cwd;
-use IPC::Open2;
-our $VERSION = '0.04';
+use Git;
+use Git::FastExport::Block;
+
+our $VERSION = '0.07';
+
+'progress 1 objects';
sub new {
my ( $class, $repo ) = @_;
my $self = bless { source => '' }, $class;
- if ($repo) {
- croak "$repo is not a Git object"
- if !( ref $repo && $repo->isa('Git') );
+ if ( defined $repo ) {
+ if ( !ref $repo ) {
+ my $dir = $repo;
+ $repo = eval { Git->repository( Directory => $dir ) }
+ or croak "$dir is not a valid git repository";
+ }
+ elsif ( !$repo->isa('Git') ) {
+ croak "$repo is not a Git object";
+ }
$self->{git} = $repo;
}
return $self;
@@ -91,38 +100,6 @@
return $block;
}
-package Git::FastExport::Block;
-
-my $LF = "\012";
-
-my %fields = (
- commit => [qw( mark author committer data from merge files )],
- tag => [qw( from tagger data )],
- reset => [qw( from )],
- blob => [qw( mark data )],
- checkpoint => [],
- progress => [],
-);
-
-sub as_string {
- my ($self) = @_;
- my $string = $self->{header} . $LF;
-
- for my $key ( @{ $fields{ $self->{type} } } ) {
- next if !exists $self->{$key};
- if ( $key eq 'data' ) {
- $string
- .= 'data ' . length( $self->{data} ) . $LF . $self->{data};
- }
- else {
- $string .= "$_$LF" for @{ $self->{$key} };
- }
- }
- return $string .= $self->{footer} || '';
-}
-
-1;
-
__END__
=head1 NAME
@@ -158,7 +135,9 @@
=item new( [ $repository ] )
-The constructor takes an optional C<Git> repository object, and returns
+The constructor takes an optional git directory (a string used
+as a parameter to C<< Git->repository( Directory => ... ) >>)
+or C<Git> repository object, and returns
a C<Git::FastExport> object attached to it.
=item fast_export( @args )
@@ -196,7 +175,7 @@
=head1 COPYRIGHT
-Copyright 2008 Philippe Bruhat (BooK), All Rights Reserved.
+Copyright 2008-2009 Philippe Bruhat (BooK), All Rights Reserved.
=head1 LICENSE
Modified: trunk/libgit-fastexport-perl/script/git-stitch-repo
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/script/git-stitch-repo?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/script/git-stitch-repo (original)
+++ trunk/libgit-fastexport-perl/script/git-stitch-repo Sun Jan 4 04:52:50 2009
@@ -1,181 +1,36 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Git;
-use Git::FastExport;
+use Pod::Usage;
+use Getopt::Long;
+use Git::FastExport::Stitch;
use File::Spec::Functions qw( rel2abs );
-our $VERSION = '0.04';
+our $VERSION = $Git::FastExport::Stitch::VERSION;
-my %repo;
+# basic command-line options
+my %option;
+GetOptions( \%option, 'help', 'manual', 'version', 'select=s' )
+ or pod2usage( -verbose => 0 );
+print "git-stitch-repo version $VERSION\n" and exit if $option{version};
+pod2usage( -verbose => 1 ) if $option{help};
+pod2usage( -verbose => 2 ) if $option{manual};
+
+my $export = Git::FastExport::Stitch->new( \%option );
# process command-line parameters
-my $name = 'A';
while (@ARGV) {
my ( $repo, $dir ) = split /:/, shift @ARGV, 2;
$repo = rel2abs($repo);
$dir ||= '';
- # create an export parser for each repo
- my $parser
- = Git::FastExport->new( Git->repository( Directory => $repo ) );
- $parser->fast_export(qw( --progress=1 --all --date-order ));
- $parser->{mapdir} = $dir;
-
- # update the %repo hash
- $repo = $parser->{source};
- $repo{$repo}{repo} = $repo;
- $repo{$repo}{dir} = $dir;
- $repo{$repo}{parser} = $parser;
- $repo{$repo}{name} = $dir || $name;
- $name++;
+ # add the repository to the list of repositories to stitch
+ $export->stitch( $repo => $dir );
}
-# repositories that we will process
-my @repos = values %repo;
-
-my $mark = 1_000_000; # mark counter in the new repo
-my %mark_map; # map marks in source repos to marks in the new repo
-
-# get the first commits
-$_->{commit} = next_commit( $_->{parser} ) for @repos;
-
-# main loop
-my $last;
-my %commits;
-while (@repos) {
-
- # sort by date
- @repos = sort { $a->{commit}{date} <=> $b->{commit}{date} } @repos;
- my $repo = $repos[0];
-
- # next commit to dump
- my $commit = $repo->{commit};
-
- # update marks & dir in files
- for ( @{ $commit->{files} } ) {
- s/^M (\d+) :(\d+)/M $1 :$mark_map{$repo->{repo}}{$2}/;
- if ( my $dir = $repo->{dir} ) {
- s!^(M \d+ :\d+) (.*)!$1 $dir/$2!; # filemodify
- s!^D (.*)!D $dir/$1!; # filedelete
-
- # /!\ quotes may happen - die and fix if needed
- die "Choked on quoted paths in $repo->{repo}! Culprit:\n$_\n"
- if /^[CR] \S+ \S+ /;
-
- # filecopy | filerename
- s!^([CR]) (\S+) (\S+)!$1 $dir/$2 $dir/$3!;
- }
- }
-
- # first commit in the old repo linked to latest commit in new repo
- if ( $last && !$commit->{from} ) {
- $commit->{from} = ["from :$last"];
- }
-
- # update historical information
- my ($id) = $commit->{mark}[0] =~ /:(\d+)/g;
- $last = $id; # last commit applied
- my $branch = ( split / /, $commit->{header} )[1];
- my $node = $commits{$id} = {
- name => $id,
- repo => $repo->{repo},
- branch => $branch,
- children => [],
- merge => exists $commit->{merge},
- };
-
- # mark our original source
- $commit->{header} =~ s/$/-$repo->{name}/;
-
- # this commit's parents
- my @parents = map {/:(\d+)/g} @{ $commit->{from} || [] },
- @{ $commit->{merge} || [] };
-
- # map each parent to its last "alien" commit
- my %parent_map = map {
- $_ => last_alien_child( $commits{$_}, $repo->{repo}, $branch )->{name}
- } @parents;
-
- # map parent marks
- for ( @{ $commit->{from} || [] }, @{ $commit->{merge} || [] } ) {
- if (m/^(from|merge) /) {
- s/:(\d+)/:$parent_map{$1}/g;
- }
- }
-
- # update the parents information
- for my $parent ( map { $parent_map{$_} } @parents ) {
- push @{ $commits{$parent}{children} }, $node->{name};
- }
-
- # dump the commit
- print $commit->as_string;
-
- # load next commit
- $repo->{commit} = next_commit( $repo->{parser} )
- or shift @repos; # no more blocks in this export
-}
-
-# return the next commit
-# - print out the intermediate blocks
-# - offset the old marks
-sub next_commit {
- my ($parser) = @_;
- my $block;
-
- while ( $block = $parser->next_block() ) {
-
- # map to the new mark
- for ( @{ $block->{mark} || [] } ) {
- s/:(\d+)/:$mark/
- and $mark_map{ $parser->{source} }{$1} = $mark++;
- }
-
- # update marks in from & merge
- for ( @{ $block->{from} || [] }, @{ $block->{merge} || [] } ) {
- if (m/^(from|merge) /) {
- s/:(\d+)/:$mark_map{$parser->{source}}{$1}/g;
- }
- }
- last if $block->{type} eq 'commit';
- print $block->as_string();
- }
- return $block;
-}
-
-# find the last child of this node
-# that has either no child
-# or a child in our repo
-sub last_alien_child {
- my ( $node, $repo, $branch ) = @_;
-
- while (1) {
-
- # no children nodes
- return $node if ( !@{ $node->{children} } );
-
- # some children nodes are local
- return $node
- if grep { $commits{$_}->{repo} eq $repo } @{ $node->{children} };
-
- # there's a child in the same branch
- if ( my ($peer)
- = grep { $commits{$_}->{branch} eq $branch }
- @{ $node->{children} } )
- {
-
- # but don't go past another repo's merges
- # FIXME - unless it only includes ancestors of ours
- return $node if $commits{$peer}->{merge};
- $node = $commits{$peer};
- }
-
- # or pick the first child (as good as any)
- else {
- $node = $commits{ $node->{children}[0] };
- }
- }
+# run the stitching algorithm
+while ( my $block = $export->next_block() ) {
+ print $block->as_string;
}
__END__
@@ -186,7 +41,16 @@
=head1 SYNOPSIS
-git-stitch-repo repo1 repo2:dir2 ...
+git-stitch-repo [ options ] repo1 repo2:dir2 ...
+
+=head1 OPTIONS
+
+ --select < first | last | random >
+ Algorithm for selection the attachment commit
+
+ --help Print a short online help and exit
+ --manual Print the full manual page and exit
+ --version Print version information and exit
=head1 DESCRIPTION
@@ -209,68 +73,27 @@
and B, with the files from A in subdirectory F<A/> and the files from
B in subdirectory F<B/>.
+ $ git checkout master-A
+ warning: You appear to be on a branch yet to be born.
+ warning: Forcing checkout of master-A.
+ Switched to branch "master-A"
+ $ git checkout master-B
+ Switched to branch "master-B"
+
+Both branches can be seen using C<gitk --all>. It is now possible to
+create the I<master> branch and have it point at the right commit,
+and delete the two I<master-A> and I<master-B> branches.
+
B<git-stich-repo> works perfectly with repositories that have a B<linear>
history (no merges). It has successfully been tested with 16 linear
repositories, and produced the expected result.
-=head2 Example
+The improvements to the stitching algorithm added in version 0.06 should
+make is suitable to work with repositories having branches and merges.
-Imagine we have two repositories A and B that we want to stitch into
-a repository C so that all the files from A are in subdirectory F<A>
-and all the files from B are in subdirectory F<B>.
+=head1 SEE ALSO
-Note: in the following ASCII art graphs, horizontal order is chronological.
-
-Repository A:
-
- topic
- ' ,master
- ,----A3---A5
- / /
- A1--A2---A4---'
-
-Branch I<master> points to A5 and branch I<topic> points to A3.
-
-Repository B:
-
- ,topic ,master
- ,---------B3---B5---B7---B8
- / /
- B1---B2---B4---B6--------'
-
-Branch I<master> points to B8 and branch I<topic> points to B5.
-
-The RESULT repository should preserve chronology, commit relationships and
-branches as much as possible, while giving the impression that the
-directories F<A/> & F<B/> did live side-by-side all the time.
-
-Assuming additional timestamps not shown on the above graphs,
-B<git-stitch-repo> will produce a B<git-fast-import> stream that will
-create the following history:
-
- ,topic-A
- ,---------------A3---B3 master-A
- / \ ' ,topic-B
- / ,--------------A5---B5
- / / \ ,master-B
- A1---B1---A2---B2---A4---B4---B6-----------------B7---B8
-
-
-=head1 BUGS & IMPROVEMENTS
-
-Any mathematician will tell you there are many many ways to stitch two
-trees together. This programs tries very hard not to create inconsistent
-history with regard to each input repository.
-
-The current implementation can (and will be) improved. I'm very interested
-in test repositories that do not give the expected results.
-
-One of the issues is that we currently refuse to stitch a node after
-a merge from another repository. For the current example, that would
-mean that any commit having A5 as a parent would be attached to B5,
-and not to B8.
-
-Fixing this is in the TODO list.
+L<Git::FastExport::Stitch>
=head1 AUTHOR
@@ -284,7 +107,7 @@
=head1 COPYRIGHT
-Copyright 2008 Philippe Bruhat (BooK), All Rights Reserved.
+Copyright 2008-2009 Philippe Bruhat (BooK), All Rights Reserved.
=head1 LICENSE
Modified: trunk/libgit-fastexport-perl/t/00load.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/t/00load.t?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/t/00load.t (original)
+++ trunk/libgit-fastexport-perl/t/00load.t Sun Jan 4 04:52:50 2009
@@ -2,6 +2,8 @@
my @modules = qw(
Git::FastExport
+ Git::FastExport::Block
+ Git::FastExport::Stitch
);
plan tests => scalar @modules;
Modified: trunk/libgit-fastexport-perl/t/01new.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/t/01new.t?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/t/01new.t (original)
+++ trunk/libgit-fastexport-perl/t/01new.t Sun Jan 4 04:52:50 2009
@@ -8,7 +8,7 @@
# alas, this can't be done with Git.pm
chdir $dir;
-`git-init`;
+`git init`;
my $git = Git->repository( Directory => $dir );
@@ -17,13 +17,17 @@
# desc, args
[''],
[ "Git->new( Directory => $dir )", $git ],
+ [ $dir, $dir ],
);
my @fails = (
# desc, error, regex, args
- [ q('zlonk'), qr/^zlonk is not a Git object/, 'zlonk' ],
+ [ q('zlonk'), qr/^zlonk is not a valid git repository/, 'zlonk' ],
[ q('zlonk'), qr/^Zlonk=HASH\S+ is not a Git object/, bless {}, 'Zlonk' ],
+
+ # [q(''), ''], # should fail (Git.pm issue)
+ # [q(0), 0], # should fail (Git.pm issue)
);
plan tests => 3 * @tests + 3 * @fails;
Modified: trunk/libgit-fastexport-perl/t/10fast-export.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/t/10fast-export.t?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/t/10fast-export.t (original)
+++ trunk/libgit-fastexport-perl/t/10fast-export.t Sun Jan 4 04:52:50 2009
@@ -1,7 +1,6 @@
use strict;
use warnings;
use Test::More;
-use File::Slurp;
my @latin = split m!^----\n!m, << 'EOT';
perferendis
Modified: trunk/libgit-fastexport-perl/t/30stitch-repo.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/t/30stitch-repo.t?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/t/30stitch-repo.t (original)
+++ trunk/libgit-fastexport-perl/t/30stitch-repo.t Sun Jan 4 04:52:50 2009
@@ -1,111 +1,215 @@
use strict;
use warnings;
use Test::More;
-use File::Temp qw( tempdir );
-use IPC::Open2;
+use File::Path;
use t::Utils;
+use Git::FastExport::Stitch;
+
+# first, make sure we have the right git version
+use Git;
+my @v = split /\./, my $version = Git->version;
+
+plan skip_all => "Git version $version doesn't provide git-fast-export"
+ . ' -- Minimum version needed: 1.5.4'
+ if !( $v[0] > 1
+ || ( $v[0] == 1
+ && ( $v[1] > 5 || ( $v[1] == 5 && $v[2] >= 4 ) ) )
+ );
my @tests = (
- # source repositories, refs, expected repository
+ # source repositories, refs, expected repository x @algo, todo x @algo
# linear trees
- [ 'A1 A2-A1 A3-A2', 'master=A3', 'A1 A2-A1 A3-A2' ],
+ # 0 - 3
+ [ 'A1 A2-A1 A3-A2', 'master=A3', 'A1 A2-A1 A3-A2', 'A1 A2-A1 A3-A2', ],
[ 'A1 A2-A1 A3-A2 B1 B2-B1 B3-B2',
'master=A3 master=B3',
- 'A1 A2-A1 A3-A2 B1-A3 B2-B1 B3-B2'
+ 'A1 A2-A1 A3-A2 B1-A3 B2-B1 B3-B2',
+ 'A1 A2-A1 A3-A2 B1-A3 B2-B1 B3-B2',
],
[ 'A1 B1 A2-A1 B2-B1 A3-A2 B3-B2',
'master=A3 master=B3',
- 'A1 B1-A1 A2-B1 B2-A2 A3-B2 B3-A3'
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 B3-A3',
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 B3-A3',
],
[ 'A1 B1 C1 A2-A1 B2-B1 C2-C1 A3-A2 B3-B2 C3-C2',
'master=A3 master=B3 master=C3',
- 'A1 B1-A1 C1-B1 A2-C1 B2-A2 C2-B2 A3-C2 B3-A3 C3-B3'
+ 'A1 B1-A1 C1-B1 A2-C1 B2-A2 C2-B2 A3-C2 B3-A3 C3-B3',
+ 'A1 B1-A1 C1-B1 A2-C1 B2-A2 C2-B2 A3-C2 B3-A3 C3-B3',
],
# simple diamonds
- [ 'A1 A2-A1 A3-A1 A4-A2A3', 'master=A4', 'A1 A2-A1 A3-A1 A4-A2A3' ],
+ # 4 - 8
+ [ 'A1 A2-A1 A3-A1 A4-A2A3',
+ 'master=A4',
+ 'A1 A2-A1 A3-A1 A4-A2A3',
+ 'A1 A2-A1 A3-A1 A4-A2A3',
+ ],
[ 'A1 A2-A1 A3-A1 A4-A2A3 B1 B2-B1 B3-B1 B4-B2B3',
'master=A4 master=B4',
- 'A1 A2-A1 A3-A1 A4-A2A3 B1-A4 B2-B1 B3-B1 B4-B2B3'
+ 'A1 A2-A1 A3-A1 A4-A2A3 B1-A4 B2-B1 B3-B1 B4-B2B3',
+ 'A1 A2-A1 A3-A1 A4-A2A3 B1-A4 B2-B1 B3-B1 B4-B2B3',
],
[ 'A1 B1 A2-A1 A3-A1 B2-B1 B3-B1 A4-A2A3 B4-B2B3',
'master=A4 master=B4',
- 'A1 B1-A1 A2-B1 B2-B1 A3-B2 B3-A2 A4-B3A3 B3-A4',
- 'The two master branches should be the same'
+ 'A1 B1-A1 A2-B1 A3-B1 B2-A3 B3-A3 A4-A2B3 B4-B2A4',
+ 'A1 B1-A1 A2-B1 A3-B1 B2-A2 B3-A2 A4-B2A3 B4-A4B3',
],
[ 'A1 B1 A2-A1 B2-B1 A3-A1 B3-B1 A4-A2A3 B4-B2B3',
'master=A4 master=B4',
- 'A1 B1-A1 A2-B1 B2-B1 A3-B2 B3-A2 A4-B3A3 B3-A4',
- 'The two master branches should be the same'
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B1 B3-A2 A4-B3A3 B4-B2A4',
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B1 B3-A2 A4-B2A3 B4-A4B3',
],
[ 'A1 B1 A2-A1 A3-A1 B2-B1 B3-B1 B4-B2B3 A4-A2A3 B5-B4 A5-A4',
'master=A5 master=B5',
- 'A1 B1-A1 A2-B1 B2-B1 A3-B2 B3-A2 B4-B3B2 B3-A4',
- 'The two master branches should be the same'
+ 'A1 B1-A1 A2-B1 A3-B1 B2-A3 B3-A3 B4-B2B3 A4-A2B4 B5-A4 A5-B5',
+ 'A1 B1-A1 A2-B1 A3-B1 B2-A2 B3-A2 B4-B2B3 A4-B4A3 B5-A4 A5-B5',
],
# other trees
+ # 9 - 10
[ 'A1 B1 A2-A1 B2-B1 A3-A2 A4-A2 B3-B2 B4-B2 A5-A4A3 B5-B3 B6-B4 B7-B6B5 B8-B7 A6-A5',
'master=A6 master=B8 topic=A3 topic=B5',
- 'A1 B1-A1 A2-B1 B2-A2 A3-B2 A4-B2 B3-A3 B4-A4 A5-B4B3 B5-A5 B6-B4 B7-B6B5 B8-B7 A6-B8',
- 'A6 should be attached to B8'
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 A4-B2 B3-A4 B4-A4 A5-B4A3 B5-B3 B6-A5 B7-B6B5 B8-B7 A6-B8',
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 A4-B2 B3-A3 B4-A3 A5-A4B3 B5-A5 B6-B4 B7-B6B5 B8-B7 A6-B8',
],
[ 'A1 B1 A2-A1 B2-B1 A3-A2 A4-A2 B3-B2 B4-B2 A5-A4A3 B5-B3 B6-B4 B7-B6B5 B8-B7 A6-A5 A7-A3 A8-A6',
'master=A8 master=B8 topic=A7 topic=B5',
- 'A1 B1-A1 A2-B1 B2-A2 A4-B2 B4-A4 B6-B4 A3-B2 B3-A3 A5-B4B3 B5-A5 B7-B5 B8-B7 A7-A5 A6-B8 A8-A6',
- 'The two master branches should be the same'
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 A4-B2 B3-A4 B4-A4 A5-B4A3 B5-B3 B6-A5 B7-B6B5 B8-B7 A6-B8 A7-A3 A8-A6',
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 A4-B2 B3-A3 B4-A3 A5-A4B3 B5-A5 B6-B4 B7-B6B5 B8-B7 A6-B8 A7-B3 A8-A6',
+ ],
+
+ # specially crafted examples
+ # 11 - 12
+ [ 'A1 B2 A3-A1 A4-A1 B5-B2 A6-A1 B7-B2',
+ 'master=A6 branch1=A3 branch2=A4 master=B5 branch1=B7',
+ 'A1 B2-A1 A3-B2 A4-B2 B5-A4 A6-B2 B7-A4',
+ 'A1 B2-A1 A3-B2 A4-B2 B5-A3 A6-B2 B7-A3',
+ ],
+ [ 'A1 B1 C1 A2-A1 B2-B1 C2-C1 A3-A1 B3-B1 C3-C1 A4-A2A3 B4-B2B3 C4-C2C3',
+ 'master=A4 master=B4 master=C4',
+ 'A1 B1-A1 C1-B1 A2-C1 B2-A2 C2-B2 A3-C1 B3-A2 C3-B2 A4-B3A3 B4-C3A4 C4-C2B4',
+ 'A1 B1-A1 C1-B1 A2-C1 B2-A2 C2-B2 A3-C1 B3-A2 C3-B2 A4-C2A3 B4-A4B3 C4-B4C3',
+ ],
+
+ # 3-way merges
+ # 13-15
+ [ 'A1 A2-A1 A3-A1 A4-A1 A5-A4A3A2',
+ 'master=A5',
+ 'A1 A2-A1 A3-A1 A4-A1 A5-A4A3A2',
+ 'A1 A2-A1 A3-A1 A4-A1 A5-A4A3A2',
+ ],
+ [ 'A1 B1 A2-A1 A3-A1 B2-B1 A4-A1 B3-B1 A5-A4A3A2 B4-B2B3',
+ 'master=A5 master=B4',
+ 'A1 B1-A1 A2-B1 A3-B1 B2-A3 A4-B1 B3-A3 A5-A4B3A2 B4-B2A5',
+ 'A1 B1-A1 A2-B1 A3-B1 B2-A2 A4-B1 B3-A2 A5-A4A3B2 B4-A5B3',
],
);
+# algorithms to test
+my @algo = qw( last first );
+
# useful hack for quick testing
- at tests = grep {$_} @tests[@ARGV] if @ARGV;
-
-plan skip_all => 'No test selected' if !@tests;
-plan tests => scalar @tests;
+my @nums = 0 .. @tests - 1;
+ at nums = grep { $_ < @tests } @ARGV if @ARGV;
+
+plan skip_all => 'No test selected' if !@nums;
+plan tests => @nums * @algo;
# the program we want to test
my $gsr = File::Spec->rel2abs('script/git-stitch-repo');
-my $lib = File::Spec->rel2abs('lib');
-
-for my $t (@tests) {
- my ( $src, $refs, $dst, $todo ) = @$t;
+
+# a counter
+my $j = 0;
+
+for my $n (@nums) {
+ my ( $src, $refs, @todo ) = @{ $tests[$n] };
+ my @dst = splice @todo, 0, scalar @algo;
# a temporary directory for our tests
- my $dir
- = File::Spec->rel2abs( tempdir( 'git-XXXXX', CLEANUP => !@ARGV ) );
+ my $dir = File::Spec->rel2abs( File::Spec->catdir( 'git-test', $n ) );
+
+ # check if we have cached the source repositories
+ my @src;
+ my $build = 0;
+ if ( -d $dir ) {
+
+ # are the source repositories correct?
+ for my $desc ( split_description($src) ) {
+ my ($name) = $desc =~ /^([A-Z]+)/;
+ push @src, my $repo = eval {
+ Git->repository(
+ Directory => File::Spec->catdir( $dir, $name ) );
+ };
+ $build++ if !$repo || repo_description($repo) ne $desc;
+ }
+
+ # remove the old RESULT dir
+ rmtree( [ File::Spec->catdir( $dir, "RESULT-$_" ) ] ) for @algo;
+ }
+ else {
+ $build = 1;
+ }
# create the source repositories
- my @src = create_repos( $dir => $src, $refs );
-
- # create the destination repository
- my $repo = new_repo( $dir => 'RESULT' );
-
- # run git-stitch-repo on the source repositories
- my ( $in, $out );
- my $pid
- = open2( $out, $in, $^X, "-I$lib", $gsr, map { $_->wc_path } @src );
-
- # run git-fast-import on the destination repository
- my ( $fh, $c ) = $repo->command_input_pipe( 'fast-import', '--quiet' );
-
- # pipe the output of git-stitch-repo into git-fast-import
- while (<$out>) {
- next if /^progress /; # ignore progress info
- print {$fh} $_;
- }
- $repo->command_close_pipe( $fh, $c );
-
- # get the description of the resulting repository
- my $result = repo_description($repo);
- if ($todo) {
- TODO: {
- local $TODO = $todo;
- is( $result, $dst, "$src => $dst" );
- }
- }
- else {
- is( $result, $dst, "$src => $dst" );
+ if ($build) {
+ my $nodes = 1 + $src =~ y/ //;
+ diag "Building repositories - please wait $nodes seconds";
+ rmtree( [$dir] );
+ @src = create_repos( $dir => $src, $refs );
+ }
+
+ # test the 'last' and 'first' algorithms
+ for my $i ( 0 .. $#algo ) {
+
+ # create the destination repository
+ my $repo = new_repo( $dir => "RESULT-$algo[$i]" );
+
+ # run the stitch algorithm on the source repositories
+ my $export = Git::FastExport::Stitch->new( { select => $algo[$i] } );
+
+ # try all possible parameters to stitch()
+ for my $src (@src) {
+ my $r;
+ if ( $j == 0 ) {
+ $r = $src->wc_path; # a string
+ }
+ elsif ( $j == 1 ) {
+ $r = $src; # a Git object
+ }
+ elsif ( $j == 2 ) {
+ $r = Git::FastExport->new($src); # a Git::FastExport
+ }
+ elsif ( $j == 3 ) {
+ $r = Git::FastExport->new($src); # an initialized
+ $r->fast_export(qw( --all --date-order )); # Git::FastExport
+ }
+ $export->stitch($r);
+ $j = ++$j % 4;
+ }
+
+ # run git-fast-import on the destination repository
+ my ( $fh, $c )
+ = $repo->command_input_pipe( 'fast-import', '--quiet' );
+
+ # pipe the output of git-stitch-repo into git-fast-import
+ while ( my $block = $export->next_block() ) {
+ next if $block->{type} eq 'progress'; # ignore progress info
+ print {$fh} $block->as_string();
+ }
+ $repo->command_close_pipe( $fh, $c );
+
+ # get the description of the resulting repository
+ my $result = repo_description($repo);
+ if ( $todo[$i] ) {
+ TODO: {
+ local $TODO = $todo[$i];
+ is( $result, $dst[$i], "$src => $dst[$i] ($algo[$i])" );
+ }
+ }
+ else {
+ is( $result, $dst[$i], "$src => $dst[$i] ($algo[$i])" );
+ }
}
}
Modified: trunk/libgit-fastexport-perl/t/Utils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libgit-fastexport-perl/t/Utils.pm?rev=29164&op=diff
==============================================================================
--- trunk/libgit-fastexport-perl/t/Utils.pm (original)
+++ trunk/libgit-fastexport-perl/t/Utils.pm Sun Jan 4 04:52:50 2009
@@ -4,12 +4,37 @@
use File::Spec;
use Cwd;
use Git;
+use Error qw( :try );
# some data for the file content
my @data = <DATA>;
-my $idx = 0;
+my $idx = 0;
+
+# Git.pm options for silencing git
+my $gitopts = { STDERR => '' };
1;
+
+sub description_of {
+
+ # interpolate with comma's in this scope
+ local $" = ', ';
+
+ # silence screaming about undefined values
+ no warnings 'uninitialized';
+
+ my @desc;
+ for my $v (@_) {
+ push @desc,
+ !defined $v ? '<undef>'
+ : $v eq '' ? "''"
+ : ref $v eq 'ARRAY' ? "[ @$v ]"
+ : ref $v eq 'HASH' ? "{ @{[map{qq'$_ => $v->{$_}'}sort keys%$v]} }"
+ : $v;
+ }
+
+ return "@desc";
+}
# create a new, empty repository
sub new_repo {
@@ -20,9 +45,12 @@
my $wc = File::Spec->rel2abs( File::Spec->catfile( $dir, $name ) );
mkpath $wc;
chdir $wc;
- `git-init`;
+ `git init`;
chdir $cwd;
- return Git->repository( Directory => $wc );
+ my $repo = Git->repository( Directory => $wc );
+ $repo->command( [qw( config user.email test at example.com )], $gitopts );
+ $repo->command( [qw( config user.name Test )], $gitopts );
+ return $repo;
}
# produce a text description of a given repository
@@ -51,6 +79,18 @@
return $desc;
}
+# split a description into descriptions of independent repositories
+sub split_description {
+ my ($desc) = @_;
+ my %desc;
+
+ for my $node ( split / /, $desc ) {
+ my ($repo) = $node =~ /^([A-Z]+)/;
+ push @{ $desc{$repo} }, $node;
+ }
+ return map { join ' ', @$_ } values %desc;
+}
+
# create a set of repositories from a given description
sub create_repos {
my ( $dir, $desc, $refs ) = @_;
@@ -58,8 +98,8 @@
for my $commit ( split / /, $desc ) {
my ( $child, $parent ) = split /-/, $commit;
- my @child = $child =~ /([A-Z]\d+)/g;
- my @parent = $parent =~ /([A-Z]\d+)/g if $parent;
+ my @child = $child =~ /([A-Z]+\d+)/g;
+ my @parent = $parent =~ /([A-Z]+\d+)/g if $parent;
die "bad node description" if @child > 1 && @parent > 1;
@@ -73,20 +113,34 @@
create_linear_commit( $info, $child[0], $parent[0] );
}
sleep 1;
+ }
+
+ # checkout a new dummy branch in each repo
+ for my $repo ( values %{ $info->{repo} } ) {
+ $repo->command( [ 'checkout', '-b', 'dummy' ], $gitopts );
}
# setup the refs (branches & tags)
for my $ref ( split / /, $refs ) {
my ( $name, $type, $commit ) = split /([>=])/, $ref;
- my $repo = $info->{repo}{ substr( $commit, 0, 1 ) };
- if ( $type eq '=' ) { # branch
- $repo->command( 'branch', '-D', $name )
+ my ($repo_name) = $commit =~ /^([A-Z]+)/;
+ my $repo = $info->{repo}{$repo_name};
+ if ( $type eq '=' ) { # branch
+ $repo->command( [ branch => '-D', $name ], $gitopts )
if grep {/^..$name$/} $repo->command('branch');
- $repo->command( 'branch', $name, $info->{sha1}{$commit} );
- }
- else { # tag
- $repo->command( 'tag', $name, $info->{sha1}{$commit} );
- }
+ $repo->command( [ branch => $name, $info->{sha1}{$commit} ],
+ $gitopts );
+ }
+ else { # tag
+ $repo->command( [ tag => $name, $info->{sha1}{$commit} ],
+ $gitopts );
+ }
+ }
+
+ # delete the dummy branch and checkout master in each repo
+ for my $repo ( values %{ $info->{repo} } ) {
+ $repo->command( [ 'checkout', 'master' ], $gitopts );
+ $repo->command( [ branch => '-D', 'dummy' ], $gitopts );
}
# return the repository objects
@@ -95,7 +149,7 @@
sub create_linear_commit {
my ( $info, $child, $parent ) = @_;
- my $name = substr( $child, 0, 1 );
+ my ($name) = $child =~ /^([A-Z]+)/g;
# create the repo if needed
my $repo = $info->{repo}{$name};
@@ -115,7 +169,7 @@
sub create_merge_commit {
my ( $info, $child, @parents ) = @_;
- my $name = substr( $child, 0, 1 );
+ my ($name) = $child =~ /^([A-Z]+)/g;
my $repo = $info->{repo}{$name};
# checkout the first parent
@@ -123,18 +177,10 @@
$repo->command( 'checkout', '-q', $info->{sha1}{$parent} );
# merge the other parents
- eval {
- $repo->command_noisy( 'merge', '-n',
- map { $info->{sha1}{$_} } @parents,
- );
- 1;
- }
- or do {
- my $base = File::Spec->catfile( $info->{dir}, $name );
- update_file( $base, $name );
- $repo->command( 'add', $name );
- $repo->command( 'commit', '-m', $child );
- };
+ $repo->command_noisy( 'merge', '-n', '-s', 'ours', '-m', $child,
+ map { $info->{sha1}{$_} } @parents,
+ );
+
$info->{sha1}{$child}
= $repo->command_oneline(qw( log -n 1 --pretty=format:%H HEAD ));
}
More information about the Pkg-perl-cvs-commits
mailing list