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 {
}
}
+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 {
}
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";
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";
}
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:
git.haskell.org / ghc.git / blobdiff