1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
#!/usr/bin/perl -w
use strict;
my @top_dirs = ("nofib", "testsuite");
my $reporoot;
my $verbose = 1;
my $ignore_failure = 0;
# --checked-out says we are pushing to a checked out tree
my $checked_out = 0;
# --core-only says we only want to push corelibs, not extralibs
my $core_only = 0;
sub message {
if ($verbose) {
print "@_\n";
}
}
sub warning {
print "warning: @_\n";
}
sub darcs {
message "== running darcs @_";
system ("darcs", @_) == 0
or $ignore_failure
or die "darcs failed: $?";
}
sub darcs_push {
darcs ("push", "--no-set-default", @_);
}
sub pushall {
my $dir;
my $ghcrepo = $checked_out ? $reporoot : "$reporoot/ghc";
darcs_push ($ghcrepo, @_);
for $dir (@top_dirs) {
if (-d $dir && -d "$dir/_darcs") {
darcs_push ("$reporoot/$dir", @_, "--repodir", $dir);
}
else {
message "== $dir not present or not a repository; skipping";
}
}
my $library_lists = $core_only
? "libraries/core-packages"
: "libraries/core-packages libraries/extra-packages";
for my $pkg (`cat $library_lists`) {
chomp $pkg;
$dir = "libraries/$pkg";
if (-d "$dir") {
darcs_push ("$reporoot/$dir", @_, "--repodir", "$dir");
}
else {
warning("$pkg doesn't exist, use 'darcs-all get' to get it");
}
}
}
sub main {
if (! -d "_darcs" || ! -d "compiler") {
die "error: darcs-all must be run from the top level of the ghc tree."
}
if ($#_ ne -1) {
while ($#_ ne -1) {
my $arg = shift;
# We handle -q here as well as lower down as we need to skip
# over it if it comes before the darcs command
if ($arg eq "-q") {
$verbose = 0;
}
elsif ($arg eq "--ignore-failure") {
$ignore_failure = 1;
}
elsif ($arg eq "--checked-out") {
$checked_out = 1;
}
elsif ($arg eq "--core-only") {
$core_only = 1;
}
else {
$reporoot = $arg;
if (grep /^-q$/, @_) {
$verbose = 0;
}
last;
}
}
}
else {
die "Where do you want to push to?";
}
pushall (@_);
}
main(@ARGV);
|
