summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorPhilFreeman <>2015-08-28 15:17:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-08-28 15:17:00 (GMT)
commit414866c38a08e4a8a56cc3b7e8b0712743cb9551 (patch)
treece9d6748a22f873d7a11a6f3ae2093d9c8b6457d /tests
parent3b2f791c57e95d3fb9c48ae7d48fa6944476d2b4 (diff)
version 0.7.4.10.7.4.1
Diffstat (limited to 'tests')
-rw-r--r--tests/Main.hs28
-rw-r--r--tests/common/TestsSetup.hs48
-rw-r--r--tests/support/setup-win.cmd3
3 files changed, 61 insertions, 18 deletions
diff --git a/tests/Main.hs b/tests/Main.hs
index acb9aa6..6644c8a 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -1,8 +1,7 @@
-----------------------------------------------------------------------------
--
-- Module : Main
--- Copyright : (c) Phil Freeman 2013
--- License : MIT
+-- License : MIT (http://opensource.org/licenses/MIT)
--
-- Maintainer : Phil Freeman <paf31@cantab.net>
-- Stability : experimental
@@ -17,6 +16,7 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
-- Failing tests can specify the kind of error that should be thrown with a
-- @shouldFailWith declaration. For example:
@@ -42,18 +42,22 @@ import qualified Language.PureScript.CoreFn as CF
import Data.Char (isSpace)
import Data.Maybe (mapMaybe, fromMaybe)
import Data.List (isSuffixOf, sort, stripPrefix)
+#if __GLASGOW_HASKELL__ < 710
import Data.Traversable (traverse)
+#endif
import Data.Time.Clock (UTCTime())
import qualified Data.Map as M
import Control.Monad
import Control.Monad.IO.Class (liftIO)
+#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
+#endif
import Control.Arrow ((>>>))
import Control.Monad.Reader
-import Control.Monad.Writer
+import Control.Monad.Writer.Strict
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Except
import Control.Monad.Error.Class
@@ -62,10 +66,13 @@ import System.Exit
import System.Process
import System.FilePath
import System.Directory
+import qualified System.Info
import qualified System.FilePath.Glob as Glob
import Text.Parsec (ParseError)
+import TestsSetup
+
modulesDir :: FilePath
modulesDir = ".test_modules" </> "node_modules"
@@ -166,11 +173,6 @@ assertDoesNotCompile inputFiles foreigns = do
trim =
dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
-findNodeProcess :: IO (Maybe String)
-findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
- where
- names = ["nodejs", "node"]
-
main :: IO ()
main = do
fetchSupportCode
@@ -205,16 +207,6 @@ main = do
in putStrLn $ fp' ++ ": " ++ err
exitFailure
-fetchSupportCode :: IO ()
-fetchSupportCode = do
- setCurrentDirectory "tests/support"
- callProcess "npm" ["install"]
- -- Sometimes we run as a root (e.g. in simple docker containers)
- -- And we are non-interactive: https://github.com/bower/bower/issues/1162
- callProcess "node_modules/.bin/bower" ["--allow-root", "install", "--config.interactive=false"]
- callProcess "node" ["setup.js"]
- setCurrentDirectory "../.."
-
supportModules :: [String]
supportModules =
[ "Control.Monad.Eff.Class"
diff --git a/tests/common/TestsSetup.hs b/tests/common/TestsSetup.hs
new file mode 100644
index 0000000..cc853ec
--- /dev/null
+++ b/tests/common/TestsSetup.hs
@@ -0,0 +1,48 @@
+-----------------------------------------------------------------------------
+--
+-- Module : Main
+-- License : MIT (http://opensource.org/licenses/MIT)
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE CPP #-}
+
+module TestsSetup where
+
+import Data.Maybe (fromMaybe)
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative
+#endif
+import Control.Monad
+
+import Control.Monad.Trans.Maybe
+
+import System.Process
+import System.Directory
+import System.Info
+
+findNodeProcess :: IO (Maybe String)
+findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
+ where
+ names = ["nodejs", "node"]
+
+fetchSupportCode :: IO ()
+fetchSupportCode = do
+ node <- fromMaybe (error "cannot find node executable") <$> findNodeProcess
+ setCurrentDirectory "tests/support"
+ if System.Info.os == "mingw32"
+ then callProcess "setup-win.cmd" []
+ else do
+ callProcess "npm" ["install"]
+ -- Sometimes we run as a root (e.g. in simple docker containers)
+ -- And we are non-interactive: https://github.com/bower/bower/issues/1162
+ callProcess "node_modules/.bin/bower" ["--allow-root", "install", "--config.interactive=false"]
+ callProcess node ["setup.js"]
+ setCurrentDirectory "../.."
diff --git a/tests/support/setup-win.cmd b/tests/support/setup-win.cmd
new file mode 100644
index 0000000..2b40898
--- /dev/null
+++ b/tests/support/setup-win.cmd
@@ -0,0 +1,3 @@
+@echo off
+call npm install
+call node_modules\.bin\bower install --config.interactive=false