Fold base.git into ghc.git (re #8545)
[ghc.git] / sync-all
index 5d7e313..70c9639 100755 (executable)
--- a/sync-all
+++ b/sync-all
@@ -7,6 +7,7 @@ use English;
 $| = 1; # autoflush stdout after each print, to avoid output after die
 
 my $initial_working_directory;
+my $exit_via_die;
 
 my $defaultrepo;
 my @packages;
@@ -19,6 +20,8 @@ my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo
 
 my %tags;
 
+my $GITHUB = qr!(?:git@|git://|https://|http://)github.com!;
+
 sub inDir {
     my $dir = shift;
     my $code = shift;
@@ -50,11 +53,12 @@ sub parsePackages {
     foreach (@repos) {
         chomp;
         $lineNum++;
-        if (/^([^# ]+) +([^ ]+) +([^ ]+)$/) {
+        if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
             my %line;
             $line{"localpath"}  = $1;
             $line{"tag"}        = $2;
             $line{"remotepath"} = $3;
+            $line{"upstreamurl"}= $4;
             push @packages, \%line;
 
             $tags{$2} = 0;
@@ -122,7 +126,7 @@ sub git {
     });
 }
 
-sub readgit {
+sub readgitline {
     my $dir = shift;
     my @args = @_;
 
@@ -137,12 +141,26 @@ sub readgit {
     });
 }
 
+sub readgit {
+    my $dir = shift;
+    my @args = @_;
+
+    &inDir($dir, sub {
+        open my $fh, '-|', 'git', @args
+            or die "Executing git @args failed: $!";
+        my $ret;
+        $ret .= $_ while <$fh>;
+        close $fh;
+        return $ret;
+    });
+}
+
 sub configure_repository {
     my $localpath = shift;
 
     &git($localpath, "config", "--local", "core.ignorecase", "true");
 
-    my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf');
+    my $autocrlf = &readgitline($localpath, 'config', '--get', 'core.autocrlf');
     if ($autocrlf eq "true") {
         &git($localpath, "config", "--local", "core.autocrlf", "false");
         &git($localpath, "reset", "--hard");
@@ -160,21 +178,22 @@ sub getrepo {
         # 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");
+        my $branch = &readgitline($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");
+            unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
+        my $remote = &readgitline($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");
+            unless $remote =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
+        $repo = &readgitline($git_dir, "config", "remote.$remote.url");
     }
 
     my $repo_base;
     my $checked_out_tree;
+    my $repo_local = 0;
 
     if ($repo =~ /^...*:/) {
         # HTTP or SSH
@@ -193,11 +212,11 @@ sub getrepo {
         # Don't drop the last part of the path if specified with -r, as
         # it expects repos of the form:
         #
-        #   http://darcs.haskell.org
+        #   http://git.haskell.org
         #
         # rather than
         #
-        #   http://darcs.haskell.org/ghc
+        #   http://git.haskell.org/ghc
         #
         if (!$defaultrepo) {
             $repo_base =~ s#/[^/]+/?$##;
@@ -205,6 +224,7 @@ sub getrepo {
     }
     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
         # Local filesystem, either absolute (C:/ or /) or relative (../) path
+        $repo_local = 1;
         $repo_base = $repo;
         if (-f "$repo/HEAD") {
             # assume a local mirror:
@@ -222,7 +242,7 @@ sub getrepo {
         die "Couldn't work out repo";
     }
 
-    return $repo_base, $checked_out_tree;
+    return $repo_base, $checked_out_tree, $repo_local;
 }
 
 sub gitall {
@@ -243,9 +263,9 @@ sub gitall {
     my $doing;
     my $start_repo;
 
-    my ($repo_base, $checked_out_tree) = getrepo();
+    my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
 
-    my $is_github_repo = $repo_base =~ m/(git@|git:\/\/|https:\/\/)github.com/;
+    my $is_github_repo = $repo_base =~ $GITHUB;
 
     @args = ();
 
@@ -399,10 +419,10 @@ sub gitall {
                 }
                 close($lsremote);
 
-                my $myhead = &readgit('.', 'rev-parse', '--verify', 'HEAD');
+                my $myhead = &readgitline('.', '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";
+                    die "Sub module $localpath needs to be pushed; see http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream";
                 }
                 
                 chdir($initial_working_directory);
@@ -412,7 +432,7 @@ sub gitall {
             # We don't automatically push to the submodules. If you want
             # to push to them then you need to use a special command, as
             # described on
-            # http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream
+            # http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream
             if ($remotepath ne "-") {
                 &git($localpath, "push", @args);
             }
@@ -455,7 +475,16 @@ sub gitall {
             my $rpath;
             $ignore_failure = 1;
             if ($remotepath eq '-') {
-                $rpath = "$repo_base/$localpath";
+                $rpath = "$localpath.git"; # N.B.: $localpath lacks the .git suffix
+                if ($localpath =~ /^libraries\//) {
+                    # FIXME: This is just a simple heuristic to
+                    # infer the remotepath for Git submodules. A
+                    # proper solution would require to parse the
+                    # .gitmodules file to obtain the actual
+                    # localpath<->remotepath mapping.
+                    $rpath =~ s/^libraries\//packages\//;
+                }
+                $rpath = "$repo_base/$rpath";
             } else {
                 $rpath = $path;
             }
@@ -527,11 +556,11 @@ sub gitall {
             }
             print "$localpath";
             print (' ' x (40 - length($localpath)));
-            my $branch = &readgit($localpath, "rev-parse", "--abbrev-ref", "HEAD");
+            my $branch = &readgitline($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");
+                unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
+            my $us   = &readgitline(".", "ls-remote", $localpath, "refs/heads/$branch");
+            my $them = &readgitline(".", "ls-remote", $compareto, "refs/heads/$branch");
             $us   =~ s/[[:space:]].*//;
             $them =~ s/[[:space:]].*//;
             die "Bad commit of mine: $us"     unless (length($us)   eq 40);
@@ -551,6 +580,40 @@ sub gitall {
     unlink "resume";
 }
 
+sub gitInitSubmodules {
+    &git(".", "submodule", "init", @_);
+
+    my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
+
+    my $submodulespaths = &readgit(".", "config", "--get-regexp", "^submodule[.].*[.]url");
+    # if we came from github, change the urls appropriately
+    while ($submodulespaths =~ m!^(submodule.libraries/[a-zA-Z0-9]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9]+).git$!gm) {
+        &git(".", "config", $1, "$2/ghc/packages-$3");
+    }
+
+    # if we came from a local repository, grab our submodules from their
+    # checkouts over there, if they exist.
+    if ($repo_local) {
+        while ($submodulespaths =~ m!^(submodule.(libraries/[a-zA-Z0-9]+).url) .*$!gm) {
+            if (-e "$repo_base/$2/.git") {
+                &git(".", "config", $1, "$repo_base/$2");
+            }
+        }
+    }
+}
+
+sub checkCurrentBranchIsMaster {
+    my $branch = `git symbolic-ref HEAD`;
+    $branch =~ s/refs\/heads\///;
+    $branch =~ s/\n//;
+
+    if ($branch !~ /master/) {
+        print "\nWarning: You are trying to 'pull' while on branch '$branch'.\n"
+            . "Updates to this script will happen on the master branch which\n"
+            . "means the version on this branch may be out of date.\n\n";
+    }
+}
+
 sub help
 {
         my $exit = shift;
@@ -572,7 +635,7 @@ Applies the command "cmd" to each repository in the tree.
 A full repository tree is obtained by first cloning the ghc
 repository, then getting the subrepositories with "sync-all get":
 
-  \$ git clone http://darcs.haskell.org/ghc.git
+  \$ git clone http://git.haskell.org/ghc.git
   \$ cd ghc
   \$ ./sync-all get
 
@@ -599,9 +662,9 @@ get
     before "get" that enable extra repositories. The full list is
     given at the end of this help. For example:
 
-    ./sync-all --testsuite get
+    ./sync-all --nofib get
 
-    would get the testsuite repository in addition to the usual set of
+    would get the nofib repository in addition to the usual set of
     subrepositories.
 
 remote add <remote-name>
@@ -612,7 +675,7 @@ remote set-url [--push] <remote-name>
     repository location in each case appropriately. For example, to
     add a new remote pointing to the upstream repositories:
 
-    ./sync-all -r http://darcs.haskell.org/ remote add upstream
+    ./sync-all -r http://git.haskell.org remote add upstream
 
     The -r flag points to the root of the repository tree (see "which
     repos to use" below). For a repository on the local filesystem it
@@ -686,11 +749,9 @@ Flags given *after* the command are passed to git.
 
   --nofib also clones the nofib benchmark suite
 
-  --testsuite also clones the ghc testsuite 
-
   --extra also clone some extra library packages
 
-  --no-dph avoids cloning the dph pacakges
+  --no-dph avoids cloning the dph packages
 
 
 ------------ Checking out a branch -------------
@@ -720,7 +781,7 @@ otherwise sync-all works on repos of form:
   <repo_base>/<remote-path>
 
 This logic lets you say
-  both    sync-all -r http://darcs.haskell.org/ghc-6.12 remote add ghc-6.12
+  both    sync-all -r http://example.org/ghc-6.12 remote add ghc-6.12
   and     sync-all -r ../working remote add working
 The latter is called a "checked-out tree".
 
@@ -761,7 +822,7 @@ sub main {
 
     $tags{"-"} = 1;
     $tags{"dph"} = 1;
-    if ($OSNAME =~ /^(MSWin32|Cygwin)$/) {
+    if ($OSNAME =~ /^(MSWin32|Cygwin|msys)$/) {
         $tags{"windows"} = 1;
     }
 
@@ -827,7 +888,7 @@ sub main {
     if ($bare_flag && ! $bare_found && ! $defaultrepo) {
         die "error: bare repository ghc.git not found.\n"
           . "       Either clone a bare ghc repo first or specify the repo location. E.g.:\n"
-          . "       ./sync-all --bare [--testsuite --nofib --extra] -r http://darcs.haskell.org/ get\n"
+          . "       ./sync-all --bare [--nofib --extra] -r http://git.haskell.org get\n"
     }
     elsif ($bare_found) {
         $bare_flag = "--bare";
@@ -870,18 +931,19 @@ sub main {
         my @submodule_args = grep(/^-q/,@_);
 
         if ($command eq "get") {
-            &git(".", "submodule", "init", @submodule_args);
+            &gitInitSubmodules(@submodule_args);
         }
+
         if ($command eq "pull") {
             my $gitConfig = &tryReadFile(".git/config");
             if ($gitConfig !~ /submodule/) {
-                &git(".", "submodule", "init", @submodule_args);
+                &gitInitSubmodules(@submodule_args);
             }
         }
         if ($command eq "get" or $command eq "pull") {
             my $gitConfig = &tryReadFile(".git/config");
             if ($gitConfig !~ /submodule/) {
-                &git(".", "submodule", "init", @submodule_args);
+                &gitInitSubmodules(@submodule_args);
             }
             &git(".", "submodule", "update", @submodule_args);
         }
@@ -889,10 +951,36 @@ sub main {
 }
 
 BEGIN {
+    my %argvHash = map { $_, 1 } @ARGV;
+    if ($argvHash {"pull"}) {
+        checkCurrentBranchIsMaster();
+    }
     $initial_working_directory = getcwd();
+
+    $SIG{__DIE__} = sub {
+      die @_ if $^S;
+      $exit_via_die = 1;
+    };
+
+    #message "== Checking for left-over testsuite/.git folder";
+    if (-d "testsuite/.git") {
+        print <<EOF;
+============================
+ATTENTION!
+
+You have a left-over testsuite/.git folder in your GHC tree!
+
+Please backup or remove it (e.g. "rm -r testsuite/.git") before
+proceeding as the testsuite Git repository is now tracked as part of
+the ghc Git repository (see #8545 for more details)
+============================
+EOF
+        die "detected obsolete testsuite/.git folder"
+    }
 }
 
 END {
+    return if $exit_via_die;
     my $ec = $?;
 
     chdir($initial_working_directory);
@@ -983,6 +1071,28 @@ Please remove it (e.g. "rm -r libraries/time"), and then run
 EOF
     }
 
+    message "== Checking for obsolete Git repo URL";
+    my $repo_url = &readgitline(".", 'config', '--get', 'remote.origin.url');
+    if ($repo_url =~ /^http:\/\/darcs.haskell.org/) {
+            print <<EOF;
+============================
+ATTENTION!
+
+You seem to be using obsolete Git repository URLs.
+
+Please run
+
+  ./sync-all -r git://git.haskell.org remote set-url
+
+or (in case port 9418/tcp is filtered by your firewall)
+
+  ./sync-all -r http://git.haskell.org remote set-url
+
+to update your local checkout to use the new Git URLs.
+============================
+EOF
+    }
+
     $? = $ec;
 }