boot

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 use Cwd;
   6 use File::Path 'rmtree';
   7 use File::Basename;
   8
   9 my %required_tag;
  10 my $validate;
  11 my $curdir;
  12
  13 $required_tag{"-"} = 1;
  14 $validate = 0;
  15
  16 $curdir = &cwd()
  17     or die "Can't find current directory: $!";
  18
  19 while ($#ARGV ne -1) {
  20     my $arg = shift @ARGV;
  21
  22     if ($arg =~ /^--required-tag=(.*)/) {
  23         $required_tag{$1} = 1;
  24     }
  25     elsif ($arg =~ /^--validate$/) {
  26         $validate = 1;
  27     }
  28     else {
  29         die "Bad arg: $arg";
  30     }
  31 }
  32
  33 sub sanity_check_line_endings {
  34     local $/ = undef;
  35     open FILE, "packages" or die "Couldn't open file: $!";
  36     binmode FILE;
  37     my $string = <FILE>;
  38     close FILE;
  39
  40     if ($string =~ /\r/) {
  41         print STDERR <<EOF;
  42 Found ^M in packages.
  43 Perhaps you need to run
  44     git config --global core.autocrlf false
  45 and re-check out the tree?
  46 EOF
  47         exit 1;
  48     }
  49 }
  50
  51 sub sanity_check_tree {
  52     my $tag;
  53     my $dir;
  54
  55     # Check that we have all boot packages.
  56     open PACKAGES, "< packages";
  57     while (<PACKAGES>) {
  58         if (/^#/) {
  59             # Comment; do nothing
  60         }
  61         elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+$/) {
  62             $dir = $1;
  63             $tag = $2;
  64
  65             # If $tag is not "-" then it is an optional repository, so its
  66             # absence isn't an error.
  67             if (defined($required_tag{$tag})) {
  68                 # We would like to just check for a .git directory here,
  69                 # but in an lndir tree we avoid making .git directories,
  70                 # so it doesn't exist. We therefore require that every repo
  71                 # has a LICENSE file instead.
  72                 if (! -f "$dir/LICENSE") {
  73                     print STDERR "Error: $dir/LICENSE doesn't exist.\n";
  74                     die "Maybe you haven't done './sync-all get'?";
  75                 }
  76             }
  77         }
  78         else {
  79             die "Bad line in packages file: $_";
  80         }
  81     }
  82     close PACKAGES;
  83 }
  84
  85 # Create libraries/*/{ghc.mk,GNUmakefile}
  86 sub boot_pkgs {
  87     my @library_dirs = ();
  88     my @tarballs = glob("libraries/tarballs/*");
  89
  90     my $tarball;
  91     my $package;
  92     my $stamp;
  93
  94     for $tarball (@tarballs) {
  95         $package = $tarball;
  96         $package =~ s#^libraries/tarballs/##;
  97         $package =~ s/-[0-9.]*(-snapshot)?\.tar\.gz$//;
  98
  99         # Sanity check, so we don't rmtree the wrong thing below
 100         if (($package eq "") || ($package =~ m#[/.\\]#)) {
 101             die "Bad package name: $package";
 102         }
 103
 104         if (-d "libraries/$package/_darcs") {
 105             print "Ignoring libraries/$package as it looks like a darcs checkout\n"
 106         }
 107         elsif (-d "libraries/$package/.git") {
 108             print "Ignoring libraries/$package as it looks like a git checkout\n"
 109         }
 110         else {
 111             if (! -d "libraries/stamp") {
 112                 mkdir "libraries/stamp";
 113             }
 114             $stamp = "libraries/stamp/$package";
 115             if ((! -d "libraries/$package") || (! -f "$stamp")
 116              || ((-M "libraries/stamp/$package") > (-M $tarball))) {
 117                 print "Unpacking $package\n";
 118                 if (-d "libraries/$package") {
 119                     &rmtree("libraries/$package")
 120                         or die "Can't remove libraries/$package: $!";
 121                 }
 122                 mkdir "libraries/$package"
 123                     or die "Can't create libraries/$package: $!";
 124                 system ("sh", "-c", "cd 'libraries/$package' && { cat ../../$tarball | gzip -d | tar xf - ; } && mv */* .") == 0
 125                     or die "Failed to unpack $package";
 126                 open STAMP, "> $stamp"
 127                     or die "Failed to open stamp file: $!";
 128                 close STAMP
 129                     or die "Failed to close stamp file: $!";
 130             }
 131         }
 132     }
 133
 134     for $package (glob "libraries/*/") {
 135         $package =~ s/\/$//;
 136         my $pkgs = "$package/ghc-packages";
 137         if (-f $pkgs) {
 138             open PKGS, "< $pkgs"
 139                 or die "Failed to open $pkgs: $!";
 140             while (<PKGS>) {
 141                 chomp;
 142                 s/\r//g;
 143                 if (/.+/) {
 144                     push @library_dirs, "$package/$_";
 145                 }
 146             }
 147         }
 148         else {
 149             push @library_dirs, $package;
 150         }
 151     }
 152
 153     for $package (@library_dirs) {
 154         my $dir = &basename($package);
 155         my @cabals = glob("$package/*.cabal");
 156         if ($#cabals > 0) {
 157             die "Too many .cabal file in $package\n";
 158         }
 159         if ($#cabals eq 0) {
 160             my $cabal = $cabals[0];
 161             my $pkg;
 162             my $top;
 163             if (-f $cabal) {
 164                 $pkg = $cabal;
 165                 $pkg =~ s#.*/##;
 166                 $pkg =~ s/\.cabal$//;
 167                 $top = $package;
 168                 $top =~ s#[^/]+#..#g;
 169                 $dir = $package;
 170                 $dir =~ s#^libraries/##g;
 171
 172                 print "Creating $package/ghc.mk\n";
 173                 open GHCMK, "> $package/ghc.mk"
 174                     or die "Opening $package/ghc.mk failed: $!";
 175                 print GHCMK "${package}_PACKAGE = ${pkg}\n";
 176                 print GHCMK "${package}_dist-install_GROUP = libraries\n";
 177                 print GHCMK "\$(eval \$(call build-package,${package},dist-install,\$(if \$(filter ${dir},\$(STAGE2_PACKAGES)),2,1)))\n";
 178                 close GHCMK
 179                     or die "Closing $package/ghc.mk failed: $!";
 180
 181                 print "Creating $package/GNUmakefile\n";
 182                 open GNUMAKEFILE, "> $package/GNUmakefile"
 183                     or die "Opening $package/GNUmakefile failed: $!";
 184                 print GNUMAKEFILE "dir = ${package}\n";
 185                 print GNUMAKEFILE "TOP = ${top}\n";
 186                 print GNUMAKEFILE "include \$(TOP)/mk/sub-makefile.mk\n";
 187                 print GNUMAKEFILE "FAST_MAKE_OPTS += stage=0\n";
 188                 close GNUMAKEFILE
 189                     or die "Closing $package/GNUmakefile failed: $!";
 190             }
 191         }
 192     }
 193 }
 194
 195 # autoreconf everything that needs it.
 196 sub autoreconf {
 197     my $dir;
 198
 199     foreach $dir (".", glob("libraries/*/")) {
 200         if (-f "$dir/configure.ac") {
 201             print "Booting $dir\n";
 202             chdir $dir or die "can't change to $dir: $!";
 203             system("autoreconf") == 0
 204                 or die "Running autoreconf failed with exitcode $?";
 205             chdir $curdir or die "can't change to $curdir: $!";
 206         }
 207     }
 208 }
 209
 210 sub checkBuildMk {
 211     if ($validate eq 0 && ! -f "mk/build.mk") {
 212         print <<EOF;
 213
 214 WARNING: You don't have a mk/build.mk file.
 215
 216 By default a standard GHC build will be done, which uses optimisation
 217 and builds the profiling libraries. This will take a long time, so may
 218 not be what you want if you are developing GHC or the libraries, rather
 219 than simply building it to use it.
 220
 221 For information on creating a mk/build.mk file, please see:
 222     http://hackage.haskell.org/trac/ghc/wiki/Building/Using#Buildconfiguration
 223
 224 EOF
 225     }
 226 }
 227
 228 &sanity_check_line_endings();
 229 &sanity_check_tree();
 230 &boot_pkgs();
 231 &autoreconf();
 232 &checkBuildMk();
 233