Fix incorrectly hidden RTS symbols
[ghc.git] / darcs-all
1 #!/usr/bin/perl -w
2
3 use strict;
4
5 # Usage:
6 #
7 # ./darcs-all [-q] [-s] [-i] [-r repo] [--nofib] [--testsuite] get [darcs get flags]
8 #   This gets the GHC core repos, if they do not already exist.
9 #   -q says to be quite, and -s to be silent.
10 #   -i says to ignore darcs errors and move on to the next repository
11 #   -r repo says to use repo as the location of package repositories
12 #   --nofib, --testsuite also get the nofib and testsuite repos respectively
13 #   The darcs get flag you are most likely to want is --complete. By
14 #   default we pass darcs the --partial flag.
15 #
16 # ./darcs-all [-q] [-s] [-i] [-r repo] cmd [darcs cmd flags]
17 #   This runs the darcs "cmd" command, with any flags you give, in all
18 #   of the repos you have checked out. e.g.
19 #       ./darcs-all pull
20 #       ./darcs-all -q send --dry-run
21 #   -q says to be quite, and -s to be silent.
22
23 $| = 1; # autoflush stdout after each print, to avoid output after die
24
25 my $defaultrepo;
26
27 my $verbose = 2;
28 my $ignore_failure = 0;
29 my $want_remote_repo = 0;
30
31 my %tags;
32
33 # Figure out where to get the other repositories from.
34 sub getrepo {
35     my $basedir = ".";
36     my $repo = $defaultrepo || `cat $basedir/_darcs/prefs/defaultrepo`;
37     chomp $repo;
38
39     my $repo_base;
40     my $checked_out_tree;
41
42     if ($repo =~ /^...*:/) {
43         # HTTP or SSH
44         # Above regex says "at least two chars before the :", to avoid
45         # catching Win32 drives ("C:\").
46         $repo_base = $repo;
47         $checked_out_tree = 0;
48
49         # Don't drop the last part of the path if specified with -r, as
50         # it expects repos of the form:
51         #
52         #   http://darcs.haskell.org
53         #
54         # rather than
55         #   
56         #   http://darcs.haskell.org/ghc
57         #
58         if (!$defaultrepo) {
59             $repo_base =~ s#/[^/]+/?$##;
60         }
61     }
62     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
63         # Local filesystem, either absolute or relative path
64         # (assumes a checked-out tree):
65         $repo_base = $repo;
66         $checked_out_tree = 1;
67     }
68     else {
69         die "Couldn't work out repo";
70     }
71
72     return $repo_base, $checked_out_tree;
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 darcs {
88     message "== running darcs @_";
89     system ("darcs", @_) == 0
90        or $ignore_failure
91        or die "darcs failed: $?";
92 }
93
94 sub darcsall {
95     my $localpath;
96     my $remotepath;
97     my $path;
98     my $tag;
99     my @repos;
100
101     my ($repo_base, $checked_out_tree) = getrepo();
102
103     open IN, "< packages" or die "Can't open packages file";
104     @repos = <IN>;
105     close IN;
106
107     REPO: foreach (@repos) {
108         chomp;
109         if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
110             $localpath = $1;
111             $tag = defined($2) ? $2 : "";
112             $remotepath = $3;
113
114             if ($checked_out_tree) {
115                 $path = "$repo_base/$localpath";
116             }
117             else {
118                 $path = "$repo_base/$remotepath";
119             }
120
121             if (-d "$localpath/_darcs") {
122                 if ($want_remote_repo) {
123                     darcs (@_, "--repodir", $localpath, $path);
124                 } else {
125                     darcs (@_, "--repodir", $localpath);
126                 }
127             }
128             elsif ($tag eq "") {
129                 message "== Required repo $localpath is missing! Skipping";
130             }
131             else {
132                 message "== $localpath repo not present; skipping";
133             }
134         }
135         elsif (! /^(#.*)?$/) {
136             die "Bad line: $_";
137         }
138     }
139 }
140
141 sub darcsget {
142     my $r_flags;
143     my $localpath;
144     my $remotepath;
145     my $path;
146     my $tag;
147     my @repos;
148
149     my ($repo_base, $checked_out_tree) = getrepo();
150
151     if (! grep /(?:--complete|--partial)/, @_) {
152         warning("adding --partial, to override use --complete");
153         $r_flags = [@_, "--partial"];
154     }
155     else {
156         $r_flags = \@_;
157     }
158
159     open IN, "< packages" or die "Can't open packages file";
160     @repos = <IN>;
161     close IN;
162
163     foreach (@repos) {
164         chomp;
165         if (/^([^ ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)$/) {
166             $localpath = $1;
167             $tag = defined($2) ? $2 : "";
168             $remotepath = $3;
169
170             if ($checked_out_tree) {
171                 $path = "$repo_base/$localpath";
172             }
173             else {
174                 $path = "$repo_base/$remotepath";
175             }
176
177             if (($tag eq "") || defined($tags{$tag})) {
178                 if (-d $localpath) {
179                     warning("$localpath already present; omitting");
180                 }
181                 else {
182                     darcs (@$r_flags, $path, $localpath);
183                 }
184             }
185         }
186         elsif (! /^(#.*)?$/) {
187             die "Bad line: $_";
188         }
189     }
190 }
191
192 sub main {
193     if (! -d "compiler") {
194         die "error: darcs-all must be run from the top level of the ghc tree."
195     }
196
197     while ($#_ ne -1) {
198         my $arg = shift;
199         # We handle -q here as well as lower down as we need to skip over it
200         # if it comes before the darcs command
201         if ($arg eq "-q") {
202             $verbose = 1;
203         }
204         elsif ($arg eq "-s") {
205             $verbose = 0;
206         }
207         elsif ($arg eq "-r") {
208             $defaultrepo = shift;
209         }
210         elsif ($arg eq "-i") {
211             $ignore_failure = 1;
212         }
213         # --nofib tells get to also grab the nofib repo.
214         # It has no effect on the other commands.
215         elsif ($arg eq "--nofib") {
216             $tags{"nofib"} = 1;
217         }
218         # --testsuite tells get to also grab the testsuite repo.
219         # It has no effect on the other commands.
220         elsif ($arg eq "--testsuite") {
221             $tags{"testsuite"} = 1;
222         }
223         else {
224             unshift @_, $arg;
225             if (grep /^-q$/, @_) {
226                 $verbose = 1;
227             }
228             last;
229         }
230     }
231
232     if ($#_ eq -1) {
233         die "What do you want to do?";
234     }
235     my $command = $_[0];
236     if ($command eq "get") {
237         darcsget @_;
238     }
239     else {
240         if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew)$/) {
241             # Hack around whatsnew failing if there are no changes
242             $ignore_failure = 1;
243         }
244         if ($command =~ /^(pul|pus|sen|put)/) {
245             $want_remote_repo = 1;
246         }
247         darcsall @_;
248     }
249 }
250
251 main(@ARGV);
252