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