6ea99ca · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Check the right kind of error is thrown in tests

6ea99caHarry Garrood11 years ago

examples/failing/365.purs+1

compare with golang

unifiedsplit

@@ -1,3 +1,4 @@

1+-- @shouldFailWith CycleInDeclaration

1module Main where

2module Main where

3import Prelude

4import Prelude

examples/failing/Object.purs+1

@@ -1,3 +1,4 @@

1+-- @shouldFailWith PropertyIsMissing

1module Main where

2module Main where

3import Prelude

4import Prelude

examples/failing/OverlappingInstances2.purs+5−6

@@ -1,3 +1,4 @@

1+-- @shouldFailWith OverlappingInstances

1module OverlappingInstances where

2module OverlappingInstances where

3import Prelude

4import Prelude

@@ -5,14 +6,12 @@ import Prelude

5data A = A | B

6data A = A | B

7instance eqA1 :: Eq A where

8instance eqA1 :: Eq A where

8− (==) A A = true

9+ eq A A = true

9− (==) B B = true

10+ eq B B = true

10− (==) _ _ = false

11+ eq _ _ = false

11− (/=) x y = not (x == y)

13instance eqA2 :: Eq A where

14− (==) _ _ = true

14+ eq _ _ = true

15− (/=) _ _ = false

17instance ordA :: Ord A where

16instance ordA :: Ord A where

18 compare A B = LT

17 compare A B = LT

tests/Main.hs+46−4

@@ -18,13 +18,30 @@

18{-# LANGUAGE GeneralizedNewtypeDeriving #-}

19{-# LANGUAGE FlexibleInstances #-}

21+-- Failing tests can specify the kind of error that should be thrown with a

22+-- @shouldFailWith declaration. For example:

23+--

24+-- "-- @shouldFailWith TypesDoNotUnify"

25+--

26+-- will cause the test to fail unless that module fails to compile with exactly

27+-- one TypesDoNotUnify error.

28+--

29+-- If a module is expected to produce multiple type errors, then use multiple

30+-- @shouldFailWith lines; for example:

31+--

32+-- -- @shouldFailWith TypesDoNotUnify

33+-- -- @shouldFailWith TypesDoNotUnify

34+-- -- @shouldFailWith TransitiveExportError

35+

21module Main (main) where

36module Main (main) where

23import qualified Language.PureScript as P

38import qualified Language.PureScript as P

24import qualified Language.PureScript.CodeGen.JS as J

39import qualified Language.PureScript.CodeGen.JS as J

25import qualified Language.PureScript.CoreFn as CF

40import qualified Language.PureScript.CoreFn as CF

27−import Data.List (isSuffixOf)

42+import Data.Char (isSpace)

43+import Data.Maybe (mapMaybe)

44+import Data.List (isSuffixOf, sort, stripPrefix)

28import Data.Traversable (traverse)

45import Data.Traversable (traverse)

29import Data.Time.Clock (UTCTime())

46import Data.Time.Clock (UTCTime())

@@ -33,6 +50,7 @@ import qualified Data.Map as M

33import Control.Monad

50import Control.Monad

34import Control.Monad.IO.Class (liftIO)

51import Control.Monad.IO.Class (liftIO)

35import Control.Applicative

52import Control.Applicative

53+import Control.Arrow ((>>>))

37import Control.Monad.Reader

55import Control.Monad.Reader

38import Control.Monad.Writer

56import Control.Monad.Writer

@@ -146,11 +164,35 @@ assertCompiles inputFiles foreigns = do

146

164

147assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()

165assertDoesNotCompile :: [FilePath] -> M.Map P.ModuleName (FilePath, P.ForeignJS) -> IO ()

148assertDoesNotCompile inputFiles foreigns = do

166assertDoesNotCompile inputFiles foreigns = do

167+ let testFile = last inputFiles

149− putStrLn $ "Assert " ++ last inputFiles ++ " does not compile"

168+ putStrLn $ "Assert " ++ testFile ++ " does not compile"

169+ shouldFailWith <- getShouldFailWith testFile

150 assert inputFiles foreigns $ \e ->

170 assert inputFiles foreigns $ \e ->

151 case e of

171 case e of

172+ Left errs -> do

152− Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> return Nothing

173+ putStrLn (P.prettyPrintMultipleErrors False errs)

174+ if null shouldFailWith

175+ then return Nothing

176+ else return $ checkShouldFailWith shouldFailWith errs

177+ Right _ ->

153− Right _ -> return $ Just "Should not have compiled"

178+ return $ Just "Should not have compiled"

179+

180+ where

181+ getShouldFailWith =

182+ readFile

183+ >>> fmap ( lines

184+ >>> mapMaybe (stripPrefix "-- @shouldFailWith ")

185+ >>> map trim

186+ )

187+

188+ checkShouldFailWith expected errs =

189+ let actual = map P.errorCode $ P.runMultipleErrors errs

190+ in if sort expected == sort actual

191+ then Nothing

192+ else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual

193+

194+ trim =

195+ dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse

154

196

155findNodeProcess :: IO (Maybe String)

197findNodeProcess :: IO (Maybe String)

156findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names

198findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names