Merge win:/cygdrive/c/ghc/git/dt
[ghc.git] / sync-all
index 71d707e..741e22b 100755 (executable)
--- a/sync-all
+++ b/sync-all
@@ -18,76 +18,20 @@ my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo
 
 my %tags;
 
-# Figure out where to get the other repositories from.
-sub getrepo {
-    my $repo;
+sub inDir {
+    my $dir = shift;
+    my $code = shift;
 
-    if (defined($defaultrepo)) {
-        $repo = $defaultrepo;
-        chomp $repo;
-    } else {
-        # Figure out where to get the other repositories from,
-        # based on where this GHC repo came from.
-        my $git_dir = $bare_flag ? "--git-dir=ghc.git" : "";
-        my $branch  = `git $git_dir branch | grep "\* " | sed "s/^\* //"`; chomp $branch;
-        my $remote  = `git $git_dir config branch.$branch.remote`;         chomp $remote;
-        if ($remote eq "") {
-            # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
-            $remote = "origin";
-        }
-        $repo       = `git $git_dir config remote.$remote.url`;            chomp $repo;
+    if ($dir ne '.') {
+        chdir($dir);
     }
 
-    my $repo_base;
-    my $checked_out_tree;
+    my $result = &$code();
 
-    if ($repo =~ /^...*:/) {
-        # HTTP or SSH
-        # Above regex says "at least two chars before the :", to avoid
-        # catching Win32 drives ("C:\").
-        $repo_base = $repo;
-
-        # --checked-out is needed if you want to use a checked-out repo
-        # over SSH or HTTP
-        if ($checked_out_flag) {
-            $checked_out_tree = 1;
-        } else {
-            $checked_out_tree = 0;
-        }
-
-        # Don't drop the last part of the path if specified with -r, as
-        # it expects repos of the form:
-        #
-        #   http://darcs.haskell.org
-        #
-        # rather than
-        #
-        #   http://darcs.haskell.org/ghc
-        #
-        if (!$defaultrepo) {
-            $repo_base =~ s#/[^/]+/?$##;
-        }
-    }
-    elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
-        # Local filesystem, either absolute (C:/ or /) or relative (../) path
-        $repo_base = $repo;
-        if (-f "$repo/HEAD") {
-            # assume a local mirror:
-            $checked_out_tree = 0;
-            $repo_base =~ s#/[^/]+/?$##;
-        } elsif (-d "$repo/ghc.git") {
-            # assume a local mirror:
-            $checked_out_tree = 0;
-        } else {
-            # assume a checked-out tree:
-            $checked_out_tree = 1;
-        }
-    }
-    else {
-        die "Couldn't work out repo";
+    if ($dir ne '.') {
+        chdir($initial_working_directory);
     }
-
-    return $repo_base, $checked_out_tree;
+    return $result;
 }
 
 sub parsePackages {
@@ -161,42 +105,121 @@ sub gitNewWorkdir {
     }
 }
 
+sub git {
+    my $dir = shift;
+    my @args = @_;
+
+    &inDir($dir, sub {
+        my $prefix = $dir eq '.' ? "" : "$dir: ";
+        message "== ${prefix}running git @args";
+
+        system ("git", @args) == 0
+            or $ignore_failure
+            or die "git failed: $?";
+    });
+}
+
+sub readgit {
+    my $dir = shift;
+    my @args = @_;
+
+    &inDir($dir, sub {
+        open my $fh, '-|', 'git', @args
+            or die "Executing git @args failed: $!";
+        my $line = <$fh>;
+        $line = "" unless defined($line);
+        chomp $line;
+        close $fh;
+        return $line;
+    });
+}
+
 sub configure_repository {
     my $localpath = shift;
 
     &git($localpath, "config", "--local", "core.ignorecase", "true");
 
-    chdir($localpath);
-    open my $git_autocrlf, '-|', 'git', 'config', '--get', 'core.autocrlf'
-        or die "Executing git config failed: $!";
-    my $autocrlf = <$git_autocrlf>;
-    $autocrlf = "" unless defined($autocrlf);
-    chomp $autocrlf;
-    close($git_autocrlf);
-    chdir($initial_working_directory);
+    my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf');
     if ($autocrlf eq "true") {
         &git($localpath, "config", "--local", "core.autocrlf", "false");
         &git($localpath, "reset", "--hard");
     }
 }
 
-sub git {
-    my $dir = shift;
+# Figure out where to get the other repositories from.
+sub getrepo {
+    my $repo;
 
-    if ($dir eq '.') {
-        message "== running git @_";
+    if (defined($defaultrepo)) {
+        $repo = $defaultrepo;
+        chomp $repo;
     } else {
-        message "== $dir: running git @_";
-        chdir($dir);
+        # Figure out where to get the other repositories from,
+        # based on where this GHC repo came from.
+        my $git_dir = $bare_flag ? "ghc.git" : ".";
+        my $branch = &readgit($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
+        die "Bad branch: $branch"
+            unless $branch =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
+        my $remote = &readgit($git_dir, "config", "branch.$branch.remote");
+        if ($remote eq "") {
+            # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
+            $remote = "origin";
+        }
+        die "Bad remote: $remote"
+            unless $remote =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
+        $repo = &readgit($git_dir, "config", "remote.$remote.url");
     }
 
-    system ("git", @_) == 0
-        or $ignore_failure
-        or die "git failed: $?";
+    my $repo_base;
+    my $checked_out_tree;
 
-    if ($dir ne '.') {
-        chdir($initial_working_directory);
+    if ($repo =~ /^...*:/) {
+        # HTTP or SSH
+        # Above regex says "at least two chars before the :", to avoid
+        # catching Win32 drives ("C:\").
+        $repo_base = $repo;
+
+        # --checked-out is needed if you want to use a checked-out repo
+        # over SSH or HTTP
+        if ($checked_out_flag) {
+            $checked_out_tree = 1;
+        } else {
+            $checked_out_tree = 0;
+        }
+
+        # Don't drop the last part of the path if specified with -r, as
+        # it expects repos of the form:
+        #
+        #   http://darcs.haskell.org
+        #
+        # rather than
+        #
+        #   http://darcs.haskell.org/ghc
+        #
+        if (!$defaultrepo) {
+            $repo_base =~ s#/[^/]+/?$##;
+        }
     }
+    elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
+        # Local filesystem, either absolute (C:/ or /) or relative (../) path
+        $repo_base = $repo;
+        if (-f "$repo/HEAD") {
+            # assume a local mirror:
+            $checked_out_tree = 0;
+            $repo_base =~ s#/[^/]+/?$##;
+        } elsif (-d "$repo/ghc.git") {
+            # assume a local mirror:
+            $checked_out_tree = 0;
+        } else {
+            # assume a checked-out tree:
+            $checked_out_tree = 1;
+        }
+    }
+    else {
+        die "Couldn't work out repo";
+    }
+
+    return $repo_base, $checked_out_tree;
 }
 
 sub gitall {
@@ -375,13 +398,7 @@ sub gitall {
                 }
                 close($lsremote);
 
-                open my $revparse, '-|', 'git', 'rev-parse', '--verify', 'HEAD'
-                    or die "Executing rev-parse failed: $!";
-                my $myhead;
-                $myhead = <$revparse>;
-                    # or die "Failed to read from rev-parse: $!";
-                chomp $myhead;
-                close($revparse);
+                my $myhead = &readgit('.', 'rev-parse', '--verify', 'HEAD');
 
                 if (not defined($remote_heads{$myhead})) {
                     die "Sub module $localpath needs to be pushed; see http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream";
@@ -489,6 +506,42 @@ sub gitall {
         elsif ($command eq "tag") {
             &git($localpath, "tag", @args);
         }
+        elsif ($command eq "compare") {
+            # Don't compare the subrepos; it doesn't work properly as
+            # they aren't on a branch.
+            next if $remotepath eq "-";
+
+            my $compareto;
+            if ($#args eq -1) {
+                $compareto = $path;
+            }
+            elsif ($#args eq 0) {
+                $compareto = "$args[0]/$localpath";
+            }
+            elsif ($#args eq 1 && $args[0] eq "-b") {
+                $compareto = "$args[1]/$remotepath";
+            }
+            else {
+                die "Bad args for compare";
+            }
+            print "$localpath";
+            print (' ' x (40 - length($localpath)));
+            my $branch = &readgit($localpath, "rev-parse", "--abbrev-ref", "HEAD");
+            die "Bad branch: $branch"
+                unless $branch =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
+            my $us   = &readgit(".", "ls-remote", $localpath, "refs/heads/$branch");
+            my $them = &readgit(".", "ls-remote", $compareto, "refs/heads/$branch");
+            $us   =~ s/[[:space:]].*//;
+            $them =~ s/[[:space:]].*//;
+            die "Bad commit of mine: $us"     unless (length($us)   eq 40);
+            die "Bad commit of theirs: $them" unless (length($them) eq 40);
+            if ($us eq $them) {
+                print "same\n";
+            }
+            else {
+                print "DIFFERENT\n";
+            }
+        }
         else {
             die "Unknown command: $command";
         }
@@ -561,6 +614,17 @@ remote set-url [--push] <remote-name>
     would point to the ghc repository, and for a remote repository it
     points to the directory containing "ghc.git".
 
+compare
+compare reporoot
+compare -b reporoot
+
+    Compare the git HEADs of the repos to the origin repos, or the
+    repos under reporoot (which is assumde to be a checked-out tree
+    unless the -b flag is used).
+
+    1 line is printed for each repo, indicating whether the repo is
+    at the "same" or a "DIFFERENT" commit.
+
 These commands just run the equivalent git command on each repository, passing
 any extra arguments to git: