Merge branch 'master' into angerman/feature/build-info-flags
authorMoritz Angermann <moritz.angermann@gmail.com>
Tue, 12 Jan 2016 06:57:35 +0000 (14:57 +0800)
committerMoritz Angermann <moritz.angermann@gmail.com>
Tue, 12 Jan 2016 06:57:35 +0000 (14:57 +0800)
# Conflicts:
# src/Main.hs

.appveyor.yml
.travis.yml
shaking-up-ghc.cabal
src/Main.hs
src/Rules/Generate.hs
src/Settings/Builders/Ar.hs
src/Settings/Builders/DeriveConstants.hs
src/Test.hs [new file with mode: 0644]
src/Way.hs

index f4f1d83..68c1fd8 100644 (file)
@@ -16,7 +16,14 @@ install:
     - bash -lc "curl -LsS http://www.haskell.org/ghc/dist/7.10.3/ghc-7.10.3-x86_64-unknown-mingw32.tar.xz | tar -xJ -C /mingw64 --strip-components=1"
     - stack exec -- pacman -S --noconfirm gcc binutils p7zip git
     - echo "" | stack --no-terminal install alex happy shake ansi-terminal mtl
-    - git clone --recursive git://git.haskell.org/ghc.git C:\msys64\home\ghc\tmp
+
+    - git config --global url."git://github.com/ghc/packages-".insteadOf     git://github.com/ghc/packages/
+    - git config --global url."http://github.com/ghc/packages-".insteadOf    http://github.com/ghc/packages/
+    - git config --global url."https://github.com/ghc/packages-".insteadOf   https://github.com/ghc/packages/
+    - git config --global url."ssh://git@github.com/ghc/packages-".insteadOf ssh://git@github.com/ghc/packages/
+    - git config --global url."git@github.com:/ghc/packages-".insteadOf      git@github.com:/ghc/packages/
+    - git clone https://github.com/ghc/ghc --recurse-submodules --depth 1 C:\msys64\home\ghc\tmp
+
     - bash -lc "mv /home/ghc/tmp/* /home/ghc"
     - cd C:\msys64\home\ghc
     - stack exec -- perl boot
@@ -30,4 +37,5 @@ install:
 
 build_script:
     - cd C:\msys64\home\ghc\shake-build
+    - echo "" | stack --no-terminal exec -- build.bat selftest
     - echo "" | stack --no-terminal exec -- build.bat -j --no-progress inplace/bin/ghc-stage1.exe
index dd3bd12..4ff35ec 100644 (file)
@@ -62,6 +62,7 @@ install:
 
 script:
     - ( cd ghc/shake-build && cabal haddock --internal )
+    - ./ghc/shake-build/build.sh selftest
     - ./ghc/shake-build/build.sh -j --no-progress $TARGET
 
 cache:
@@ -71,7 +72,7 @@ cache:
 
 notifications:
     irc:
-        on_success: always # always/never/change
+        on_success: change # always/never/change
         on_failure: always
         channels:
             - "chat.freenode.net#shaking-up-ghc"
index 545425b..b38feac 100644 (file)
@@ -101,6 +101,7 @@ executable ghc-shake
                        , Settings.Ways
                        , Stage
                        , Target
+                       , Test
                        , Way
 
     default-extensions:  BangPatterns
@@ -112,6 +113,7 @@ executable ghc-shake
                        , FlexibleInstances
                        , OverloadedStrings
                        , RecordWildCards
+                       , ScopedTypeVariables
     build-depends:       base
                        , ansi-terminal >= 0.6
                        , Cabal >= 1.22
@@ -119,6 +121,7 @@ executable ghc-shake
                        , directory >= 1.2
                        , extra >= 1.4
                        , mtl >= 2.2
+                       , QuickCheck >= 2.6
                        , shake >= 0.15
                        , transformers >= 0.4
                        , unordered-containers >= 0.2
index f65483d..6d79cb8 100644 (file)
@@ -11,7 +11,11 @@ import qualified Rules.Gmp
 import qualified Rules.Libffi
 import qualified Rules.Oracles
 import qualified Rules.Perl
+<<<<<<< HEAD
 import Oracles.Config.CmdLineFlag (cmdLineOracle, flags)
+=======
+import qualified Test
+>>>>>>> master
 
 main :: IO ()
 main = shakeArgsWith options flags $ \cmdLineFlags targets ->
@@ -30,7 +34,8 @@ main = shakeArgsWith options flags $ \cmdLineFlags targets ->
         , Rules.Gmp.gmpRules
         , Rules.Libffi.libffiRules
         , Rules.Oracles.oracleRules
-        , Rules.packageRules ]
+        , Rules.packageRules
+        , Test.testRules ]
     options = shakeOptions
         { shakeFiles    = Base.shakeFilesPath
         , shakeProgress = progressSimple
index 4fd7da6..025f1ee 100644 (file)
@@ -19,7 +19,6 @@ import Rules.Gmp
 import Rules.Libffi
 import Rules.Resources (Resources)
 import Settings
-import Settings.Builders.DeriveConstants
 
 installTargets :: [FilePath]
 installTargets = [ "inplace/lib/template-hsc.h"
@@ -53,6 +52,9 @@ ghcPrimDependencies stage = ((targetPath stage ghcPrim -/- "build") -/-) <$>
        [ "GHC/PrimopWrappers.hs"
        , "autogen/GHC/Prim.hs" ]
 
+derivedConstantsPath :: FilePath
+derivedConstantsPath = "includes/dist-derivedconstants/header"
+
 derivedConstantsDependencies :: [FilePath]
 derivedConstantsDependencies = installTargets ++ fmap (derivedConstantsPath -/-)
     [ "DerivedConstants.h"
@@ -178,9 +180,10 @@ generateRules = do
         generate ghcSplit emptyTarget generateGhcSplit
         makeExecutable ghcSplit
 
-    -- TODO: simplify
+    -- TODO: simplify, get rid of fake rts target
     derivedConstantsPath ++ "//*" %> \file -> do
-        build $ fullTarget (PartialTarget Stage1 rts) DeriveConstants [] [file]
+        withTempDir $ \dir -> build $
+            fullTarget (PartialTarget Stage1 rts) DeriveConstants [] [file, dir]
 
   where
     file <~ gen = file %> \out -> generate out emptyTarget gen
index 86f4310..59b70b8 100644 (file)
@@ -1,4 +1,4 @@
-module Settings.Builders.Ar (arBuilderArgs, arCmd) where
+module Settings.Builders.Ar (arBuilderArgs, arCmd, chunksOfSize) where
 
 import Base
 import Expression
@@ -46,15 +46,7 @@ useSuccessiveInvocations path flagArgs fileArgs = do
         unit . cmd [path] $ flagArgs ++ argsChunk
 
 -- | @chunksOfSize size strings@ splits a given list of strings into chunks not
--- exceeding the given @size@.
+-- exceeding the given @size@. If that is impossible, it uses singleton chunks.
 chunksOfSize :: Int -> [String] -> [[String]]
-chunksOfSize _    [] = []
-chunksOfSize size strings = reverse chunk : chunksOfSize size rest
-  where
-    (chunk, rest) = go [] 0 strings
-    go res _         []     = (res, [])
-    go res chunkSize (s:ss) =
-        if newSize > size then (res, s:ss) else go (s:res) newSize ss
-      where
-        newSize = chunkSize + length s
-
+chunksOfSize n = repeatedly f
+    where f xs = splitAt (max 1 $ length $ takeWhile (<= n) $ scanl1 (+) $ map length xs) xs
index 6f4828a..fb578f5 100644 (file)
@@ -1,6 +1,4 @@
-module Settings.Builders.DeriveConstants (
-    derivedConstantsPath, deriveConstantsBuilderArgs
-    ) where
+module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where
 
 import Base
 import Expression
@@ -9,21 +7,19 @@ import Oracles.Config.Setting
 import Predicates (builder, file)
 import Settings.Builders.Common
 
-derivedConstantsPath :: FilePath
-derivedConstantsPath = "includes/dist-derivedconstants/header"
-
 -- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`?
 deriveConstantsBuilderArgs :: Args
 deriveConstantsBuilderArgs = builder DeriveConstants ? do
-    cFlags <- fromDiffExpr includeCcArgs
+    cFlags            <- fromDiffExpr includeCcArgs
+    [output, tempDir] <- getOutputs
     mconcat
         [ file "//DerivedConstants.h"             ? arg "--gen-header"
         , file "//GHCConstantsHaskellType.hs"     ? arg "--gen-haskell-type"
         , file "//platformConstants"              ? arg "--gen-haskell-value"
         , file "//GHCConstantsHaskellWrappers.hs" ? arg "--gen-haskell-wrappers"
         , file "//GHCConstantsHaskellExports.hs"  ? arg "--gen-haskell-exports"
-        , arg "-o", arg =<< getOutput
-        , arg "--tmpdir", arg derivedConstantsPath
+        , arg "-o", arg output
+        , arg "--tmpdir", arg tempDir
         , arg "--gcc-program", arg =<< getBuilderPath (Gcc Stage1)
         , append . concat $ map (\a -> ["--gcc-flag", a]) cFlags
         , arg "--nm-program", arg =<< getBuilderPath Nm
diff --git a/src/Test.hs b/src/Test.hs
new file mode 100644 (file)
index 0000000..6cbc557
--- /dev/null
@@ -0,0 +1,28 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Test (testRules) where
+
+import Way
+import Development.Shake
+import Test.QuickCheck
+import Settings.Builders.Ar(chunksOfSize)
+
+instance Arbitrary Way where
+    arbitrary = wayFromUnits <$> arbitrary
+
+instance Arbitrary WayUnit where
+    arbitrary = arbitraryBoundedEnum
+
+testRules :: Rules ()
+testRules =
+    phony "selftest" $ do
+        test $ \(x :: Way) -> read (show x) == x
+        test $ \n xs ->
+            let res = chunksOfSize n xs
+            in concat res == xs && all (\r -> length r == 1 || length (concat r) <= n) res
+        test $ chunksOfSize 3 ["a","b","c","defg","hi","jk"] == [["a","b","c"],["defg"],["hi"],["jk"]]
+
+
+test :: Testable a => a -> Action ()
+test = liftIO . quickCheck
index 3b1f6c0..ba20bd7 100644 (file)
@@ -1,5 +1,5 @@
 module Way (
-    WayUnit (..), Way, wayUnit,
+    WayUnit (..), Way, wayUnit, wayFromUnits,
 
     vanilla, profiling, logging, parallel, granSim,
     threaded, threadedProfiling, threadedLogging,