Better computeDiscount for ValAppCtxt
[ghc.git] / sync-all
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Cwd;
5
6 $| = 1; # autoflush stdout after each print, to avoid output after die
7
8 my $initial_working_directory;
9
10 my $defaultrepo;
11 my @packages;
12 my $verbose = 2;
13 my $try_to_resume = 0;
14 my $ignore_failure = 0;
15 my $checked_out_flag = 0; # NOT the opposite of bare_flag (describes remote repo state)
16 my $get_mode;
17 my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo state)
18
19 my %tags;
20
21 sub inDir {
22     my $dir = shift;
23     my $code = shift;
24
25     if ($dir ne '.') {
26         chdir($dir);
27     }
28
29     my $result = &$code();
30
31     if ($dir ne '.') {
32         chdir($initial_working_directory);
33     }
34     return $result;
35 }
36
37 sub parsePackages {
38     my @repos;
39     my $lineNum;
40
41     open IN, "< packages.conf"
42         or open IN, "< packages" # clashes with packages directory when using --bare
43         or die "Can't open packages file (or packages.conf)";
44     @repos = <IN>;
45     close IN;
46
47     @packages = ();
48     $lineNum = 0;
49     foreach (@repos) {
50         chomp;
51         $lineNum++;
52         if (/^([^# ]+) +([^ ]+) +([^ ]+)$/) {
53             my %line;
54             $line{"localpath"}  = $1;
55             $line{"tag"}        = $2;
56             $line{"remotepath"} = $3;
57             push @packages, \%line;
58         }
59         elsif (! /^(#.*)?$/) {
60             die "Bad content on line $lineNum of packages file: $_";
61         }
62     }
63 }
64
65 sub tryReadFile {
66     my $filename = shift;
67     my @lines;
68
69     open (FH, $filename) or return "";
70     @lines = <FH>;
71     close FH;
72     return join('', @lines);
73 }
74
75 sub message {
76     if ($verbose >= 2) {
77         print "@_\n";
78     }
79 }
80
81 sub warning {
82     if ($verbose >= 1) {
83         print "warning: @_\n";
84     }
85 }
86
87 sub gitNewWorkdir {
88     my $dir = shift;
89     my $target = shift;
90     my $target_dir = "$target/$dir";
91
92     if ($dir eq '.') {
93         message "== running git-new-workdir . $target_dir @_";
94     } else {
95         message "== $dir: running git-new-workdir . $target_dir @_";
96         chdir($dir);
97     }
98
99     system ("git-new-workdir", ".", $target_dir, @_) == 0
100         or $ignore_failure
101         or die "git-new-workdir failed: $?";
102
103     if ($dir ne '.') {
104         chdir($initial_working_directory);
105     }
106 }
107
108 sub git {
109     my $dir = shift;
110     my @args = @_;
111
112     &inDir($dir, sub {
113         my $prefix = $dir eq '.' ? "" : "$dir: ";
114         message "== ${prefix}running git @args";
115
116         system ("git", @args) == 0
117             or $ignore_failure
118             or die "git failed: $?";
119     });
120 }
121
122 sub readgit {
123     my $dir = shift;
124     my @args = @_;
125
126     &inDir($dir, sub {
127         open my $fh, '-|', 'git', @args
128             or die "Executing git @args failed: $!";
129         my $line = <$fh>;
130         $line = "" unless defined($line);
131         chomp $line;
132         close $fh;
133         return $line;
134     });
135 }
136
137 sub configure_repository {
138     my $localpath = shift;
139
140     &git($localpath, "config", "--local", "core.ignorecase", "true");
141
142     my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf');
143     if ($autocrlf eq "true") {
144         &git($localpath, "config", "--local", "core.autocrlf", "false");
145         &git($localpath, "reset", "--hard");
146     }
147 }
148
149 # Figure out where to get the other repositories from.
150 sub getrepo {
151     my $repo;
152
153     if (defined($defaultrepo)) {
154         $repo = $defaultrepo;
155         chomp $repo;
156     } else {
157         # Figure out where to get the other repositories from,
158         # based on where this GHC repo came from.
159         my $git_dir = $bare_flag ? "ghc.git" : ".";
160         my $branch = &readgit($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
161         die "Bad branch: $branch"
162             unless $branch =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
163         my $remote = &readgit($git_dir, "config", "branch.$branch.remote");
164         if ($remote eq "") {
165             # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
166             $remote = "origin";
167         }
168         die "Bad remote: $remote"
169             unless $remote =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
170         $repo = &readgit($git_dir, "config", "remote.$remote.url");
171     }
172
173     my $repo_base;
174     my $checked_out_tree;
175
176     if ($repo =~ /^...*:/) {
177         # HTTP or SSH
178         # Above regex says "at least two chars before the :", to avoid
179         # catching Win32 drives ("C:\").
180         $repo_base = $repo;
181
182         # --checked-out is needed if you want to use a checked-out repo
183         # over SSH or HTTP
184         if ($checked_out_flag) {
185             $checked_out_tree = 1;
186         } else {
187             $checked_out_tree = 0;
188         }
189
190         # Don't drop the last part of the path if specified with -r, as
191         # it expects repos of the form:
192         #
193         #   http://darcs.haskell.org
194         #
195         # rather than
196         #
197         #   http://darcs.haskell.org/ghc
198         #
199         if (!$defaultrepo) {
200             $repo_base =~ s#/[^/]+/?$##;
201         }
202     }
203     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
204         # Local filesystem, either absolute (C:/ or /) or relative (../) path
205         $repo_base = $repo;
206         if (-f "$repo/HEAD") {
207             # assume a local mirror:
208             $checked_out_tree = 0;
209             $repo_base =~ s#/[^/]+/?$##;
210         } elsif (-d "$repo/ghc.git") {
211             # assume a local mirror:
212             $checked_out_tree = 0;
213         } else {
214             # assume a checked-out tree:
215             $checked_out_tree = 1;
216         }
217     }
218     else {
219         die "Couldn't work out repo";
220     }
221
222     return $repo_base, $checked_out_tree;
223 }
224
225 sub gitall {
226     my $command = shift;
227
228     my $localpath;
229     my $tag;
230     my $remotepath;
231     my $line;
232     my $branch_name;
233     my $subcommand;
234
235     my $path;
236
237     my @args;
238
239     my $started;
240     my $doing;
241     my $start_repo;
242
243     my ($repo_base, $checked_out_tree) = getrepo();
244
245     my $is_github_repo = $repo_base =~ m/(git@|git:\/\/|https:\/\/)github.com/;
246
247     parsePackages;
248
249     @args = ();
250
251     if ($command =~ /^remote$/) {
252         while (@_ > 0 && $_[0] =~ /^-/) {
253             push(@args,shift);
254         }
255         if (@_ < 1) { help(1); }
256         $subcommand = shift;
257         if ($subcommand ne 'add' &&
258             $subcommand ne 'rm' &&
259             $subcommand ne 'set-branches' &&
260             $subcommand ne 'set-url') {
261             help(1);
262         }
263         while (@_ > 0 && $_[0] =~ /^-/) {
264             push(@args,shift);
265         }
266         if (($subcommand eq 'add' || $subcommand eq 'rm') && @_ < 1) {
267             help(1);
268         } elsif (@_ < 1) { # set-url
269             $branch_name = 'origin';
270         } else {
271             $branch_name = shift;
272         }
273     } elsif ($command eq 'new') {
274         if (@_ < 1) {
275             $branch_name = 'origin';
276         } else {
277             $branch_name = shift;
278         }
279     }
280
281     push(@args, @_);
282
283     # $doing is a good enough approximation to what we are doing that
284     # we can use it to check that --resume is resuming the right command
285     $doing = join(" ", ($command, @args));
286     $started = 1;
287     if ($try_to_resume && -f "resume") {
288         my $what;
289         open RESUME, "< resume"
290             or die "Can't open resume file";
291         $start_repo = <RESUME>;
292         chomp $start_repo;
293         $what = <RESUME>;
294         chomp $what;
295         close RESUME;
296         if ($what eq $doing) {
297             $started = 0;
298         }
299     }
300
301     for $line (@packages) {
302         $tag        = $$line{"tag"};
303         # Use the "remote" structure for bare git repositories
304         $localpath  = ($bare_flag) ?
305                       $$line{"remotepath"} : $$line{"localpath"};
306         $remotepath = ($checked_out_tree) ?
307                       $$line{"localpath"}  : $$line{"remotepath"};
308
309         if (!$started) {
310             if ($start_repo eq $localpath) {
311                 $started = 1;
312             }
313             else {
314                 next;
315             }
316         }
317
318         open RESUME, "> resume.tmp";
319         print RESUME "$localpath\n";
320         print RESUME "$doing\n";
321         close RESUME;
322         rename "resume.tmp", "resume";
323
324         # We can't create directories on GitHub, so we translate
325         # "packages/foo" into "package-foo".
326         if ($is_github_repo) {
327             $remotepath =~ s/\//-/;
328         }
329
330         # Construct the path for this package in the repo we pulled from
331         $path = "$repo_base/$remotepath";
332
333         if ($command eq "get") {
334             next if $remotepath eq "-"; # "git submodule init/update" will get this later
335
336             # Skip any repositories we have not included the tag for
337             if (not defined($tags{$tag})) {
338                 $tags{$tag} = 0;
339             }
340             if ($tags{$tag} == 0) {
341                 next;
342             }
343
344             if (-d $localpath) {
345                 warning("$localpath already present; omitting")
346                     if $localpath ne ".";
347                 &configure_repository($localpath);
348                 next;
349             }
350
351             # Note that we use "." as the path, as $localpath
352             # doesn't exist yet.
353             my @argsWithBare = @args;
354             push @argsWithBare, $bare_flag if $bare_flag;
355             &git(".", "clone", $path, $localpath, @argsWithBare);
356             &configure_repository($localpath);
357             next;
358         }
359
360         my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath");
361         if (not $git_repo_present) {
362             if ($tag eq "") {
363                 die "Required repo $localpath is missing";
364             }
365             else {
366                  message "== $localpath repo not present; skipping";
367                  next;
368             }
369         }
370
371         # Work out the arguments we should give to the SCM
372         if ($command eq "status") {
373             &git($localpath, $command, @args);
374         }
375         elsif ($command eq "commit") {
376             # git fails if there is nothing to commit, so ignore failures
377             $ignore_failure = 1;
378             &git($localpath, "commit", @args);
379         }
380         elsif ($command eq "check_submodules") {
381             # If we have a submodule then check whether it is up-to-date
382             if ($remotepath eq "-") {
383                 my %remote_heads;
384
385                 message "== Checking sub-module $localpath";
386
387                 chdir($localpath);
388
389                 open my $lsremote, '-|', 'git', 'ls-remote', '--heads', '-q'
390                     or die "Executing ls-remote failed: $!";
391                 while (<$lsremote>) {
392                     if (/^([0-9a-f]{40})\s*refs\/heads\//) {
393                         $remote_heads{$1} = 1;
394                     }
395                     else {
396                         die "Bad output from ls-remote: $_";
397                     }
398                 }
399                 close($lsremote);
400
401                 my $myhead = &readgit('.', 'rev-parse', '--verify', 'HEAD');
402
403                 if (not defined($remote_heads{$myhead})) {
404                     die "Sub module $localpath needs to be pushed; see http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream";
405                 }
406                 
407                 chdir($initial_working_directory);
408             }
409         }
410         elsif ($command eq "push") {
411             # We don't automatically push to the submodules. If you want
412             # to push to them then you need to use a special command, as
413             # described on
414             # http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream
415             if ($remotepath ne "-") {
416                 &git($localpath, "push", @args);
417             }
418         }
419         elsif ($command eq "pull") {
420             my $realcmd;
421             my @realargs;
422             if ($remotepath eq "-") {
423                 # Only fetch for the submodules. "git submodule update"
424                 # will take care of making us point to the right commit.
425                 $realcmd = "fetch";
426                 # we like "sync-all pull --rebase" to work:
427                 @realargs = grep(!/--rebase/,@args);
428             }
429             else {
430                 $realcmd = "pull";
431                 @realargs = @args;
432             }
433             &git($localpath, $realcmd, @realargs);
434         }
435         elsif ($command eq "new-workdir") {
436             gitNewWorkdir ($localpath, @args);
437         }
438         elsif ($command eq "send") {
439             $command = "send-email";
440             &git($localpath, $command, @args);
441         }
442         elsif ($command eq "fetch") {
443             &git($localpath, "fetch", @args);
444         }
445         elsif ($command eq "new") {
446             my @scm_args = ("log", "$branch_name..");
447             &git($localpath, @scm_args, @args);
448         }
449         elsif ($command eq "log") {
450             &git($localpath, "log", @args);
451         }
452         elsif ($command eq "remote") {
453             my @scm_args;
454             my $rpath;
455             $ignore_failure = 1;
456             if ($remotepath eq '-') {
457                 $rpath = "$repo_base/$localpath";
458             } else {
459                 $rpath = $path;
460             }
461             if ($subcommand eq 'add') {
462                 @scm_args = ("remote", "add", $branch_name, $rpath);
463             } elsif ($subcommand eq 'rm') {
464                 @scm_args = ("remote", "rm", $branch_name);
465             } elsif ($subcommand eq 'set-branches') {
466                 @scm_args = ("remote", "set-branches", $branch_name);
467             } elsif ($subcommand eq 'set-url') {
468                 @scm_args = ("remote", "set-url", $branch_name, $rpath);
469             }
470             &git($localpath, @scm_args, @args);
471         }
472         elsif ($command eq "checkout") {
473             # Not all repos are necessarily branched, so ignore failure
474             $ignore_failure = 1;
475             &git($localpath, "checkout", @args);
476         }
477         elsif ($command eq "grep") {
478             # Hack around 'git grep' failing if there are no matches
479             $ignore_failure = 1;
480             &git($localpath, "grep", @args);
481         }
482         elsif ($command eq "diff") {
483             &git($localpath, "diff", @args);
484         }
485         elsif ($command eq "clean") {
486             &git($localpath, "clean", @args);
487         }
488         elsif ($command eq "reset") {
489             &git($localpath, "reset", @args);
490         }
491         elsif ($command eq "branch") {
492             &git($localpath, "branch", @args);
493         }
494         elsif ($command eq "config") {
495             &git($localpath, "config", @args);
496         }
497         elsif ($command eq "repack") {
498             &git($localpath, "repack", @args);
499         }
500         elsif ($command eq "format-patch") {
501             &git($localpath, "format-patch", @args);
502         }
503         elsif ($command eq "gc") {
504             &git($localpath, "gc", @args);
505         }
506         elsif ($command eq "tag") {
507             &git($localpath, "tag", @args);
508         }
509         elsif ($command eq "compare") {
510             # Don't compare the subrepos; it doesn't work properly as
511             # they aren't on a branch.
512             next if $remotepath eq "-";
513
514             my $compareto;
515             if ($#args eq -1) {
516                 $compareto = $path;
517             }
518             elsif ($#args eq 0) {
519                 $compareto = "$args[0]/$localpath";
520             }
521             elsif ($#args eq 1 && $args[0] eq "-b") {
522                 $compareto = "$args[1]/$remotepath";
523             }
524             else {
525                 die "Bad args for compare";
526             }
527             print "$localpath";
528             print (' ' x (40 - length($localpath)));
529             my $branch = &readgit($localpath, "rev-parse", "--abbrev-ref", "HEAD");
530             die "Bad branch: $branch"
531                 unless $branch =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
532             my $us   = &readgit(".", "ls-remote", $localpath, "refs/heads/$branch");
533             my $them = &readgit(".", "ls-remote", $compareto, "refs/heads/$branch");
534             $us   =~ s/[[:space:]].*//;
535             $them =~ s/[[:space:]].*//;
536             die "Bad commit of mine: $us"     unless (length($us)   eq 40);
537             die "Bad commit of theirs: $them" unless (length($them) eq 40);
538             if ($us eq $them) {
539                 print "same\n";
540             }
541             else {
542                 print "DIFFERENT\n";
543             }
544         }
545         else {
546             die "Unknown command: $command";
547         }
548     }
549
550     unlink "resume";
551 }
552
553 sub help
554 {
555         my $exit = shift;
556
557         # Get the built in help
558         my $help = <<END;
559 Usage:
560
561 ./sync-all [-q] [-s] [--ignore-failure] [-r repo] [--checked-out] [--bare]
562            [--nofib] [--extra] [--testsuite] [--no-dph] [--resume]
563            cmd [git flags]
564
565 Applies the command "cmd" to each repository in the tree.
566
567 A full repository tree is obtained by first cloning the ghc
568 repository, then getting the subrepositories with "sync-all get":
569
570   \$ git clone http://darcs.haskell.org/ghc.git
571   \$ cd ghc
572   \$ ./sync-all get
573
574 After this, "./sync-all pull" will pull from the original repository
575 tree.
576
577 A remote pointing to another local repository tree can be added like
578 this:
579
580   \$ ./sync-all -r /path/to/ghc remote add otherlocal
581
582 and then we can pull from this other tree with
583
584   \$ ./sync-all pull otherlocal
585
586 -------------- Commands -----------------
587 get
588
589     Clones all sub-repositories from the same place that the ghc
590     repository was cloned from. See "which repos to use" below
591     for details of how the subrepositories are laid out.
592
593     There are various --<package-tag> options that can be given
594     before "get" that enable extra repositories. The full list is
595     given at the end of this help. For example:
596
597     ./sync-all --testsuite get
598
599     would get the testsuite repository in addition to the usual set of
600     subrepositories.
601
602 remote add <remote-name>
603 remote rm <remote-name>
604 remote set-url [--push] <remote-name>
605
606     Runs a "git remote" command on each subrepository, adjusting the
607     repository location in each case appropriately. For example, to
608     add a new remote pointing to the upstream repositories:
609
610     ./sync-all -r http://darcs.haskell.org/ remote add upstream
611
612     The -r flag points to the root of the repository tree (see "which
613     repos to use" below). For a repository on the local filesystem it
614     would point to the ghc repository, and for a remote repository it
615     points to the directory containing "ghc.git".
616
617 compare
618 compare reporoot
619 compare -b reporoot
620
621     Compare the git HEADs of the repos to the origin repos, or the
622     repos under reporoot (which is assumde to be a checked-out tree
623     unless the -b flag is used).
624
625     1 line is printed for each repo, indicating whether the repo is
626     at the "same" or a "DIFFERENT" commit.
627
628 These commands just run the equivalent git command on each repository, passing
629 any extra arguments to git:
630
631   branch
632   checkout
633   clean
634   commit
635   config
636   diff
637   fetch
638   format-patch
639   gc
640   grep
641   log
642   new
643   new-workdir
644   pull
645   push
646   repack
647   reset
648   send
649   status
650   tag
651
652 -------------- Flags -------------------
653 These flags are given *before* the command and modify the way sync-all behaves.
654 Flags given *after* the command are passed to git.
655
656   -q says to be quiet, and -s to be silent.
657
658   --resume will restart a command that failed, from the repo at which it
659   failed. This means you don't need to wait while, e.g., "pull" goes through
660   all the repos it's just pulled, and tries to pull them again.
661
662   --ignore-failure says to ignore errors and move on to the next repository
663
664   -r repo says to use repo as the location of package repositories
665
666   --checked-out says that the remote repo is in checked-out layout, as opposed
667   to the layout used for the main repo. By default a repo on the local
668   filesystem is assumed to be checked-out, and repos accessed via HTTP or SSH
669   are assumed to be in the main repo layout; use --checked-out to override the
670   latter.
671
672   --bare says that the local repo is in bare layout, same as the main repo. It
673   also means that these repos are bare. You only have to use this flag if you
674   don't have a bare ghc.git in the current directory and would like to 'get'
675   all of the repos bare. Requires packages.conf to be present in the current
676   directory (a renamed packages file from the main ghc repo).
677
678   Note: --checked-out and --bare flags are NOT the opposite of each other.
679         --checked-out: describes the layout of the remote repository tree.
680         --bare:        describes the layout of the local repository tree.
681
682   --nofib also clones the nofib benchmark suite
683
684   --testsuite also clones the ghc testsuite 
685
686   --extra also clone some extra library packages
687
688   --no-dph avoids cloning the dph pacakges
689
690
691 ------------ Checking out a branch -------------
692 To check out a branch you can run the following command:
693
694   \$ ./sync-all checkout ghc-7.4
695
696
697 ------------ Which repos to use -------------
698 sync-all uses the following algorithm to decide which remote repos to use
699
700 It always computes the remote repos from a single base, <repo_base> How is
701 <repo_base> set? If you say "-r repo", then that's <repo_base> otherwise
702 <repo_base> is set by asking git where the ghc repo came from, and removing the
703 last component (e.g. /ghc.git/ or /ghc/).
704
705 Then sync-all iterates over the package found in the file ./packages; see that
706 file for a description of the contents.
707
708 If <repo_base> looks like a local filesystem path, or if you give the
709 --checked-out flag, sync-all works on repos of form:
710
711   <repo_base>/<local-path>
712
713 otherwise sync-all works on repos of form:
714
715   <repo_base>/<remote-path>
716
717 This logic lets you say
718   both    sync-all -r http://darcs.haskell.org/ghc-6.12 remote add ghc-6.12
719   and     sync-all -r ../working remote add working
720 The latter is called a "checked-out tree".
721
722 sync-all *ignores* the defaultrepo of all repos other than the root one. So the
723 remote repos must be laid out in one of the two formats given by <local-path>
724 and <remote-path> in the file 'packages'.
725
726 Available package-tags are:
727 END
728
729         # Collect all the tags in the packages file
730         my %available_tags;
731         open IN, "< packages.conf"
732             or open IN, "< packages" # clashes with packages directory when using --bare
733             or die "Can't open packages file (or packages.conf)";
734         while (<IN>) {
735             chomp;
736             if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
737                 if (defined($2) && $2 ne "-") {
738                     $available_tags{$2} = 1;
739                 }
740             }
741             elsif (! /^(#.*)?$/) {
742                 die "Bad line: $_";
743             }
744         }
745         close IN;
746
747         # Show those tags and the help text
748         my @available_tags = keys %available_tags;
749         print "$help@available_tags\n\n";
750         exit $exit;
751 }
752
753 sub main {
754
755     $tags{"-"} = 1;
756     $tags{"dph"} = 1;
757
758     while ($#_ ne -1) {
759         my $arg = shift;
760         # We handle -q here as well as lower down as we need to skip over it
761         # if it comes before the source-control command
762         if ($arg eq "-q") {
763             $verbose = 1;
764         }
765         elsif ($arg eq "-s") {
766             $verbose = 0;
767         }
768         elsif ($arg eq "-r") {
769             $defaultrepo = shift;
770         }
771         elsif ($arg eq "--resume") {
772             $try_to_resume = 1;
773         }
774         elsif ($arg eq "--ignore-failure") {
775             $ignore_failure = 1;
776         }
777         elsif ($arg eq "--complete" || $arg eq "--partial") {
778             $get_mode = $arg;
779         }
780         # Use --checked-out if the _remote_ repos are a checked-out tree,
781         # rather than the master trees.
782         elsif ($arg eq "--checked-out") {
783             $checked_out_flag = 1;
784         }
785         # Use --bare if the _local_ repos are bare repos,
786         # rather than a checked-out tree.
787         elsif ($arg eq "--bare") {
788             $bare_flag = $arg;
789         }
790         elsif ($arg eq "--help") {
791             help(0);
792         }
793         # --<tag> says we grab the libs tagged 'tag' with
794         # 'get'. It has no effect on the other commands.
795         elsif ($arg =~ m/^--no-(.*)$/) {
796             $tags{$1} = 0;
797         }
798         elsif ($arg =~ m/^--(.*)$/) {
799             $tags{$1} = 1;
800         }
801         else {
802             unshift @_, $arg;
803             if (grep /^-q$/, @_) {
804                 $verbose = 1;
805             }
806             last;
807         }
808     }
809
810     # check for ghc repositories in cwd
811     my $checked_out_found = 1 if (-d ".git" && -d "compiler");
812     my $bare_found = 1 if (-d "ghc.git");
813
814     if ($bare_flag && ! $bare_found && ! $defaultrepo) {
815         die "error: bare repository ghc.git not found.\n"
816           . "       Either clone a bare ghc repo first or specify the repo location. E.g.:\n"
817           . "       ./sync-all --bare [--testsuite --nofib --extra] -r http://darcs.haskell.org/ get\n"
818     }
819     elsif ($bare_found) {
820         $bare_flag = "--bare";
821     }
822     elsif (! $bare_flag && ! $checked_out_found) {
823         die "error: sync-all must be run from the top level of the ghc tree.";
824     }
825
826     if ($#_ eq -1) {
827         help(1);
828     }
829     else {
830         # Give the command and rest of the arguments to the main loop
831         # We normalise command names here to avoid duplicating the
832         # abbreviations that we allow.
833         my $command = shift;
834
835         if ($command =~ /^(?:g|ge|get)$/) {
836             $command = "get";
837         }
838         elsif ($command =~ /^(?:pus|push)$/) {
839             $command = "push";
840         }
841         elsif ($command =~ /^(?:pul|pull)$/) {
842             $command = "pull";
843         }
844         elsif ($command =~ /^(?:s|se|sen|send)$/) {
845             $command = "send";
846         }
847         elsif ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew|status)$/) {
848             $command = "status";
849         }
850
851         if ($command eq "push") {
852             &gitall("check_submodules", @_);
853         }
854
855         &gitall($command, @_);
856
857         my @submodule_args = grep(/^-q/,@_);
858
859         if ($command eq "get") {
860             &git(".", "submodule", "init", @submodule_args);
861         }
862         if ($command eq "pull") {
863             my $gitConfig = &tryReadFile(".git/config");
864             if ($gitConfig !~ /submodule/) {
865                 &git(".", "submodule", "init", @submodule_args);
866             }
867         }
868         if ($command eq "get" or $command eq "pull") {
869             my $gitConfig = &tryReadFile(".git/config");
870             if ($gitConfig !~ /submodule/) {
871                 &git(".", "submodule", "init", @submodule_args);
872             }
873             &git(".", "submodule", "update", @submodule_args);
874         }
875     }
876 }
877
878 BEGIN {
879     $initial_working_directory = getcwd();
880 }
881
882 END {
883     my $ec = $?;
884
885     chdir($initial_working_directory);
886
887     message "== Checking for old haddock repo";
888     if (-d "utils/haddock/.git") {
889         chdir("utils/haddock");
890         if ((system "git log -1 87e2ca11c3d1b1bc49900fba0b5c5c6f85650718 > /dev/null 2> /dev/null") == 0) {
891             print <<EOF;
892 ============================
893 ATTENTION!
894
895 You have an old haddock repository in your GHC tree!
896
897 Please remove it (e.g. "rm -r utils/haddock"), and then run
898 "./sync-all get" to get the new repository.
899 ============================
900 EOF
901         }
902         chdir($initial_working_directory);
903     }
904
905     message "== Checking for old binary repo";
906     if (-d "libraries/binary/.git") {
907         chdir("libraries/binary");
908         if ((system "git log -1 749ac0efbde3b14901417364a872796598747aaf > /dev/null 2> /dev/null") == 0) {
909             print <<EOF;
910 ============================
911 ATTENTION!
912
913 You have an old binary repository in your GHC tree!
914
915 Please remove it (e.g. "rm -r libraries/binary"), and then run
916 "./sync-all get" to get the new repository.
917 ============================
918 EOF
919         }
920         chdir($initial_working_directory);
921     }
922
923     message "== Checking for old mtl repo";
924     if (-d "libraries/mtl/.git") {
925         chdir("libraries/mtl");
926         if ((system "git log -1 c67d8f7247c612dc35242bc67e616f7ea35eadb9 > /dev/null 2> /dev/null") == 0) {
927             print <<EOF;
928 ============================
929 ATTENTION!
930
931 You have an old mtl repository in your GHC tree!
932
933 Please remove it (e.g. "rm -r libraries/mtl"), and then run
934 "./sync-all get" to get the new repository.
935 ============================
936 EOF
937         }
938         chdir($initial_working_directory);
939     }
940
941     message "== Checking for old Cabal repo";
942     if (-d "libraries/Cabal/.git") {
943         chdir("libraries/Cabal");
944         if ((system "git log -1 c8ebd66a32865f72ae03ee0663c62df3d77f08fe > /dev/null 2> /dev/null") == 0) {
945             print <<EOF;
946 ============================
947 ATTENTION!
948
949 You have an old Cabal repository in your GHC tree!
950
951 Please remove it (e.g. "rm -r libraries/Cabal"), and then run
952 "./sync-all get" to get the new repository.
953 ============================
954 EOF
955         }
956         chdir($initial_working_directory);
957     }
958
959     message "== Checking for old time from tarball";
960     if (-d "libraries/time" and ! -e "libraries/time/.git") {
961             print <<EOF;
962 ============================
963 ATTENTION!
964
965 You have an old time package in your GHC tree!
966
967 Please remove it (e.g. "rm -r libraries/time"), and then run
968 "./sync-all get" to get the new repository.
969 ============================
970 EOF
971     }
972
973     $? = $ec;
974 }
975
976 main(@ARGV);
977