packages feed

cabal-test (empty) → 0.1

raw patch · 4 files changed

+293/−0 lines, 4 filesdep +Cabaldep +QuickCheckdep +basebuild-type:Customsetup-changed

Dependencies added: Cabal, QuickCheck, base, filepath, ghc, pqc

Files

+ LICENSE view
@@ -0,0 +1,35 @@+Copyright (c) 2004-2006, David Himmelstrup+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++    * Redistributions of source code must retain+      the above copyright notice, this list of+      conditions and the following disclaimer.+    * Redistributions in binary form must reproduce+      the above copyright notice, this list of+      conditions and the following disclaimer in the+      documentation and/or other materials provided+      with the distribution.+    * Neither the name of David Himmelstrup nor the+      names of other contributors may be used to+      endorse or promote products derived from this+      software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple++> main = defaultMain+
+ cabal-test.cabal view
@@ -0,0 +1,21 @@+Name: cabal-test+Version: 0.1+Maintainer: Lemmih (lemmih@gmail.com)+Author: Lemmih (lemmih@gmail.com)+Copyright: 2006-2007, Lemmih+Category: Testing+License-File: LICENSE+License: BSD3+Build-Depends: base, Cabal, filepath, QuickCheck, pqc, ghc+Synopsis: Automated test tool for cabal projects.+Description:+  Cabal-test is a tool for testing cabal projects. It uses the GHC-api to load the code so any+  code currently buildable by GHCi should be testable by cabal-test.+  You can choose how many tests to run and how many to run concurrently.++Executable: cabal-test+Main-is: Main.hs+Extensions: +GHC-Options: -fwarn-duplicate-exports+             -fwarn-unused-binds -fwarn-unused-imports -fwarn-unused-matches+Hs-Source-Dirs: src
+ src/Main.hs view
@@ -0,0 +1,231 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main+-- Copyright   :  (c) David Himmelstrup 2006+-- License     :  BSD-like+--+-- Maintainer  :  lemmih@gmail.com+-- Stability   :  provisional+-- Portability :  GHC specific+--+-- Test a cabal project (library+executables) using parallel quickcheck.+-----------------------------------------------------------------------------+module Main+    ( main ) where++import Data.Maybe           ( fromJust )+import Data.List            ( nub, intersperse, isPrefixOf, tails )+import System.Environment   ( getArgs )+import System.IO            ( hGetLine )+import System.Exit+import System.Directory     ( doesFileExist )+import System.Process       ( runInteractiveProcess, waitForProcess )+import System.FilePath      ( (</>), replaceExtension )+import Control.Monad        ( when, filterM, forM_ )+import Control.Exception+import Text.Printf          ( printf )++import Distribution.PackageDescription+import Distribution.Simple.LocalBuildInfo+import Distribution.Package+import Distribution.Compiler+import Distribution.PreProcess+import Distribution.Simple.Utils+import Distribution.Simple.Configure++import GHC                  -- lots+import DriverPipeline       ( compileFile )+import DriverPhases         ( Phase(..) )+import DynFlags             ( defaultDynFlags )+import BasicTypes           ( failed )+import Outputable           ( showSDocForUser, ppr )+import Name                 ( getOccString )+import Util                 ( consIORef )+import StaticFlags          ( v_Ld_inputs )++import Setup                ( parseArguments )+import Config               ( Config(..) )++import Tests()++--------------------------------------------------------------+-- Main+--------------------------------------------------------------++main :: IO ()+main = do (paths, cfg) <- parseArguments =<< getArgs+          libdir <- getLibDir cfg+          let cfg' = cfg{confLibDir = libdir}+          case paths of+            [] -> testCabalProject cfg' "."+            _  -> mapM_ (testCabalProject cfg') paths++--------------------------------------------------------------+-- Output+--------------------------------------------------------------++out :: Config -> String -> IO ()+out cfg | confVerbose cfg > 0 = putStrLn+out _ = const (return ())++info :: Config -> String -> IO ()+info cfg | confVerbose cfg > 1 = putStrLn+info _ = const (return ())++debug :: Config -> String -> IO ()+debug cfg | confVerbose cfg > 3 = putStrLn+debug _ = const (return ())++--------------------------------------------------------------+-- Utils+--------------------------------------------------------------+++getLibDir :: Config -> IO FilePath+getLibDir cfg+    = do debug cfg $ "Using ghc command: " ++ (confGHCPath cfg)+         (_,outh,_,pid) <- runInteractiveProcess (confGHCPath cfg) ["--print-libdir"] Nothing Nothing+         libDir <- hGetLine outh+         waitForProcess pid+         return libDir++constructGHCCmdLine+        :: LocalBuildInfo+        -> BuildInfo+        -> [String]+constructGHCCmdLine lbi bi =+            -- Unsupported extensions have already been checked by configure+     snd (extensionsToGHCFlag (extensions bi))+     ++ hcOptions GHC (options bi)+     ++ ["-hide-all-packages"]+     ++ ["-i"]+     ++ ["-i" ++ autogenModulesDir lbi]+     ++ ["-l" ++lib | lib <- extraLibs bi]+     ++ ["-i" ++ l | l <- nub (hsSourceDirs bi)]+     ++ ["-I" ++ dir | dir <- includeDirs bi]+     ++ ["-optc" ++ opt | opt <- ccOptions bi]+     ++ [ "-odir",  "/tmp"]+     ++ [ "-#include \"" ++ inc ++ "\"" | inc <- includes bi ]+     ++ ["-D__CABAL_TEST__"]+     ++ ["-package","QuickCheck","-package","pqc"]+     ++ ["-v0","-w"]+     ++ (concat [ ["-package", showPackageId pkg] | pkg <- packageDeps lbi ])++getCabalDesc :: FilePath -> IO PackageDescription+getCabalDesc rootDir+    = do cabalFile <- findPackageDesc rootDir+         readPackageDescription (rootDir </> cabalFile)++getLocalBuildInfo :: FilePath -> IO LocalBuildInfo+getLocalBuildInfo rootDir+    = do str <- readFile lbiFile+         case reads str of+           [(lbi,_)] -> return lbi+           _ -> error $ "Invalid local build file: " ++ lbiFile+    where lbiFile = rootDir </> localBuildInfoFile+++++--------------------------------------------------------------+-- The tester+--------------------------------------------------------------++buildCSources :: Config -> Session -> BuildInfo -> IO ()+buildCSources _ _ buildinfo | null (cSources buildinfo)+    = return ()+buildCSources cfg session buildinfo+    = do debug cfg $ "    Building C Sources..."+         dflags <- GHC.getSessionDynFlags session+         forM_ cFiles $ \cFile ->+             do let cArgs = ["-I" ++ dir | dir <- includeDirs buildinfo]+                            ++ ["-optc" ++ opt | opt <- ccOptions buildinfo]+                            ++ ["-odir", "/tmp", "-c"]+                (dflags', _) <- GHC.parseDynamicFlags dflags cArgs+                debug cfg $ "      Building: " ++ show cFile+                compileFile dflags' StopLn (cFile,Nothing)+                return ()+    where cFiles = cSources buildinfo+         ++buildTarget :: Config -> Session -> BuildInfo ->[String] -> IO [Name]+buildTarget cfg session buildinfo targetsPreliminary+    = do buildCSources cfg session buildinfo+         let targets' = targetsPreliminary -- ++ otherModules buildinfo+             cObjs = map (\cFile -> "/tmp" </> cFile `replaceExtension` "o") (cSources buildinfo)+         mapM_ (consIORef v_Ld_inputs) (reverse cObjs)+         targets <- mapM (flip GHC.guessTarget Nothing) targets'+         setTargets session targets+         mbDepGraph <- depanal session [] True+         let sortedTargets = nub $ reverse $ map ms_mod (fromJust mbDepGraph)+         setTargets session [ Target (TargetModule (moduleName m)) Nothing+                            | m <- sortedTargets ]+         info cfg $ "    Compiling"+         status <- GHC.load session LoadAllTargets+         when (failed status) $ fail "Failed to compile"+         info cfg $ "    Compilation done"+         result <- getModuleGraph session+         GHC.setContext session (map ms_mod result) []+         scope <- getNamesInScope session+         let f n = moduleIsInterpreted session (nameModule n)+         filterM f scope+++configSession :: Config -> Session -> LocalBuildInfo -> BuildInfo -> IO ()+configSession cfg session lbi buildinfo+    = do dflags0 <- GHC.getSessionDynFlags session+         let dflags1 = dflags0 {ghcMode = Interactive, hscTarget=HscInterpreted}+             cabalFlags = constructGHCCmdLine lbi buildinfo+         debug cfg $ "Cabal flags: " ++ show cabalFlags+         (dflags2, _) <- GHC.parseDynamicFlags dflags1 $ cabalFlags+         GHC.setSessionDynFlags session dflags2+         return ()++runProps :: Config -> Session -> [Name] -> IO ()+runProps cfg session props+    = do let unqual = (\m _ -> Just (moduleName m), \m -> Just (modulePackageId m))+             propsStr = flip map props $ \name ->+                let pretty = showSDocForUser (\_ _ -> Nothing, \_ -> Nothing) (ppr name)+                    fn = showSDocForUser unqual (ppr name)+                in printf "(\"%s\", Test.QuickCheck.Parallel.pDet %s)" pretty fn+             propsList = "[" ++ concat (intersperse "," propsStr) ++ "]"+             pRun = "Test.QuickCheck.Parallel.pRun"+             expr = printf "%s %d %d $ %s" pRun (confThreads cfg) (confTests cfg) propsList+         debug cfg $ "Running: " ++ expr+         result <- runStmt session expr+         case result of+           RunFailed -> putStrLn "Compilation failed." >> exitFailure+           RunException exp -> throwIO exp+           _ -> return ()+++testTarget :: Config -> Session -> LocalBuildInfo -> BuildInfo -> [String] -> IO ()+testTarget cfg session lbi buildinfo targets+    = defaultErrorHandler defaultDynFlags $+      do configSession cfg session lbi buildinfo+         scope <- buildTarget cfg session buildinfo targets+         let contains key lst = any (key `isPrefixOf`) (tails lst)+             props = filter (contains (confPropTag cfg).getOccString) scope+         runProps cfg session props+         GHC.setTargets session []+         GHC.load session LoadAllTargets+         return ()+++testCabalProject :: Config -> FilePath -> IO ()+testCabalProject cfg path+    = do pkg <- getCabalDesc path+         lbi <- getLocalBuildInfo path+         session <- GHC.newSession Interactive (Just (confLibDir cfg))+         out cfg $ "Testing " ++ showPackageId (package pkg)+         preprocessSources pkg lbi 0 knownSuffixHandlers+         case library pkg of+           Nothing -> do out cfg $ "  No library"+           Just lib -> do out cfg $ "  Testing library"+                          testTarget cfg session lbi (libBuildInfo lib) (exposedModules lib)+         forM_ (executables pkg) $ \exe ->+             do out cfg $ "  Testing executable: " ++ exeName exe+                let targets = map (</> modulePath exe) (hsSourceDirs (buildInfo exe))+                targets' <- filterM doesFileExist targets+                testTarget cfg session lbi (buildInfo exe) targets'+         return ()