integrated some changes from bringert (separate install for Hugs and GHC)

** more tests for install hugs and ghc
** test --install-prefix
** checked return codes for more operations
** broke Install targets into separate functions for GHC and Hugs
** started using pathJoin and copyFile
** still more integration to go.

Distribution/ModuleTest.hs

@@ -46,7 +46,7 @@ module Main where
 
 -- Import everything, since we want to test the compilation of them:
 
-import qualified Distribution.Version as D.V (hunitTests) 
+import qualified Distribution.Version as D.V (hunitTests)
 -- import qualified Distribution.InstalledPackageInfo(hunitTests)
 import qualified Distribution.Misc as D.M (hunitTests)
 import qualified Distribution.Package as D.P (hunitTests)
@@ -57,6 +57,7 @@ import qualified Distribution.Simple.Install as D.S.I (hunitTests)
 import qualified Distribution.Simple.Build as D.S.B (hunitTests)
 import qualified Distribution.Simple.SrcDist as D.S.S (hunitTests)
 import qualified Distribution.Simple.Utils as D.S.U (hunitTests)
+import Distribution.Simple.Utils(pathJoin)
 import qualified Distribution.Simple.Configure as D.S.C (hunitTests)
 import qualified Distribution.Simple.Register as D.S.R (hunitTests)
 
@@ -78,6 +79,23 @@ runTestTT'  (TestLabel l t)
     = putStrLn (label l) >> runTestTT t
 runTestTT' t = runTestTT t
 
+
+checkTargetDir :: FilePath
+               -> [String] -- ^suffixes
+               -> IO ()
+checkTargetDir targetDir suffixes
+    = do doesDirectoryExist targetDir >>=
+           assertBool "target dir exists"
+         let files = [x++y |
+                      x <- ["A", "B/A"],
+                      y <- suffixes]
+         allFilesE <- sequence [doesFileExist (targetDir ++ t)
+                                | t <- files]
+
+         sequence [assertBool ("target file missing: " ++ targetDir ++ f) e
+                   | (e, f) <- zip allFilesE files]
+         return ()
+
 tests :: [Test]
 tests = [TestCase $
          do setCurrentDirectory "test"
@@ -85,30 +103,36 @@ tests = [TestCase $
             when dirE1 (system "rm -r ,tmp">>return())
             dirE2 <- doesDirectoryExist "dist"
             when dirE2 (system "rm -r dist">>return())
---            system "ls"
-            system "./setup configure --prefix=,tmp"
-            let targetDir = ",tmp/lib/test-1.0/"
+            system "./setup configure --ghc --prefix=,tmp"
+             >>= assertEqual "configure returned error code" ExitSuccess
             system "./setup build"
-            instRetCode <- system "./setup install --user"
-            doesDirectoryExist targetDir >>=
-              assertBool "target dir exists"
-            let files = "libHStest-1.0.a":[x++y |
-                                           x <- ["A", "B/A"],
-                                           y <- [".o", ".hi", ".hs"]]
-            allFilesE <- sequence [doesFileExist (targetDir ++ t)
-                                     | t <- files]
-
-            sequence [assertBool ("target file missing: " ++ targetDir ++ f) e
-                       | (e, f) <- zip allFilesE files]
+             >>= assertEqual "build returned error code" ExitSuccess
+
             system "./setup sdist"
+             >>= assertEqual "setup sdist returned error code" ExitSuccess
             doesFileExist "dist/test-1.0.tgz" >>= 
               assertBool "sdist did not put the expected file in place"
             doesFileExist "dist/src" >>=
               assertEqual "dist/src exists" False
             doesDirectoryExist "dist/build" >>=
-              assertBool "dist/build doesn't exists"
+              assertBool "dist/build doesn't exists",
+         TestCase $ -- GHC and --install-prefix (uses above config)
+         do let targetDir = ",tmp2"
+            instRetCode <- system $ "./setup install --install-prefix=" ++ targetDir
+            checkTargetDir ",tmp2/lib/test-1.0/" [".hi"]
+            doesFileExist (pathJoin [",tmp2/lib/test-1.0/", "libHStest-1.0.a"])
+              >>= assertBool "library doesn't exist"
+            assertEqual "install returned error code" ExitSuccess instRetCode,
+         TestCase $ -- no intsall-prefix and hugs
+         do system "./setup configure --hugs --prefix=,tmp"
+             >>= assertEqual "HUGS configure returned error code" ExitSuccess
+            system "./setup build"
+             >>= assertEqual "HUGS build returned error code" ExitSuccess
+            instRetCode <- system "./setup install --user"
+            let targetDir = ",tmp/lib/test-1.0/"
+            checkTargetDir targetDir [".hs"]
             assertEqual "install returned error code" ExitSuccess instRetCode
-        ]
+         ]
 
 main :: IO ()
 main = do putStrLn "compile successful"

Distribution/Simple/Install.hs

@@ -53,7 +53,10 @@ module Distribution.Simple.Install (
 import Distribution.Package (PackageDescription(..), showPackageId)
 import Distribution.Simple.Configure(LocalBuildInfo(..))
 import Distribution.Simple.Utils(setupMessage, moveSources,
-                                 pathSeperatorStr, mkLibName)
+                                 pathSeperatorStr, mkLibName, pathJoin,
+                                 copyFile, die
+                                )
+import Distribution.Setup (CompilerFlavor(..), Compiler(..))
 
 import System.Cmd(system)
 
@@ -61,27 +64,37 @@ import System.Cmd(system)
 import HUnit (Test)
 #endif
 
--- |FIX: for now, only works with hugs or sdist-style
--- installation... must implement for .hi files and such...  how do we
--- know which files to expect?
+-- |FIX: nhc isn't implemented yet.
 install :: FilePath  -- ^build location
         -> PackageDescription -> LocalBuildInfo
         -> Maybe FilePath -- ^install-prefix
         -> IO ()
 install buildPref pkg_descr lbi install_prefixM = do
-  let pref = (maybe (prefix lbi) id install_prefixM) ++
-             pathSeperatorStr ++ "lib" ++ pathSeperatorStr ++ (showPackageId $ package pkg_descr)
-  setupMessage "Installing" pkg_descr
-  -- FIX: For hugs only
-  moveSources "" pref (allModules pkg_descr) (mainModules pkg_descr) ["lhs", "hs"]
-  -- FIX: for GHC and NHC only
-  moveSources buildPref pref (allModules pkg_descr) (mainModules pkg_descr) ["hi"]
-  moveSources buildPref pref (allModules pkg_descr) (mainModules pkg_descr) ["o"]
-  system $ "cp " ++ mkLibName buildPref (showPackageId (package pkg_descr))
-                 ++ " " ++ mkLibName pref (showPackageId (package pkg_descr))
+  let pref = pathJoin [(maybe (prefix lbi) id install_prefixM), "lib",
+                       (showPackageId $ package pkg_descr)]
+  setupMessage ("Installing: " ++ pref) pkg_descr
+  case compilerFlavor (compiler lbi) of
+     GHC  -> installGHC pref buildPref pkg_descr
+     Hugs -> installHugs pref pkg_descr
+     _    -> die ("only installing with GHC or Hugs is implemented")
   return ()
   -- register step should be performed by caller.
 
+-- |Install for ghc, .hi and .a
+installGHC :: FilePath -- ^install location
+           -> FilePath -- ^Build location
+           -> PackageDescription -> IO ()
+installGHC pref buildPref pkg_descr
+    = do moveSources buildPref pref (allModules pkg_descr) (mainModules pkg_descr) ["hi"]
+         copyFile (mkLibName buildPref (showPackageId (package pkg_descr)))
+                    (mkLibName pref (showPackageId (package pkg_descr)))
+
+-- |Install for hugs, .lhs and .hs
+installHugs :: FilePath -- ^Install location
+            -> PackageDescription -> IO ()
+installHugs pref pkg_descr
+    = moveSources "" pref (allModules pkg_descr) (mainModules pkg_descr) ["lhs", "hs"]
+
 -- -----------------------------------------------------------------------------
 -- Installation policies
 

Distribution/Simple/Utils.hs

@@ -57,6 +57,8 @@ module Distribution.Simple.Utils (
         hunitTests,
         createIfNotExists,
         mkLibName,
+        copyFile,
+        pathJoin
   ) where
 
 import Distribution.Package (PackageDescription(..), showPackageId)
@@ -298,6 +300,16 @@ mkLibName :: FilePath -- ^file Prefix
           -> String
 mkLibName pref lib = pref ++ pathSeperatorStr ++ "libHS" ++ lib ++ ".a"
 
+-- | Create a path from a list of path elements
+pathJoin :: [String] -> FilePath
+pathJoin = concat . intersperse pathSeperatorStr
+
+-- FIX: does not preserve dates, does not set permissions
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile src dest 
+    | dest == src = fail "copyFile: source and destination are the same file"
+    | otherwise = readFile src >>= writeFile dest
+
 -- ------------------------------------------------------------
 -- * Testing
 -- ------------------------------------------------------------

Distribution/TODO

+* Quick
+** fix "Seperator" - use pathJoin
+** use copyFile instead of "cp"
+
 * misc
-** setup test suite to run on --push?
 ** Possibly create a (native?) zib library?
 ** port code to windows
-** test / port code for Hugs and nhc
 ** ./Setup.lhs build for nhc
 ** nhc-pkg (see old package manager code)
 ** hugs-pkg
 ** better command-line parsing interface
 ** ./Setup.lhs bdist
 
+* testing
+** count errors and output.
+** setup test suite to run on --push?
+** redirect non-hunit outputs to a file?
+** test / port code for Hugs and nhc
+
 * Code
+** FIX: does it try to register when we have "install --inst-prefix"?
+   (write test case)
 ** FIX: install currently moves .hs, .hi, and .o files for any target.
    make it do the right thing for hugs (just move .hs) and {g,n}hc
    (move .hi and .o)