@@ -27,7 +27,7 @@ import qualified Language.PureScript as P
2727
2828import Data.Char (isSpace)
2929import Data.Function (on)
30−import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy)
30+import Data.List (sort, stripPrefix, intercalate, groupBy, sortBy, minimumBy)
3131import Data.Maybe (mapMaybe)
3232import Data.Time.Clock (UTCTime())
3333import Data.Tuple (swap)
@@ -58,31 +58,40 @@ main = hspec spec
5858spec :: Spec
5959spec = do
6060
61− (supportExterns, passingTestCases, failingTestCases) <- runIO $ do
61+ (supportExterns, passingTestCases, warningTestCases, failingTestCases) <- runIO $ do
6262 cwd <- getCurrentDirectory
6363 let passing = cwd </> "examples" </> "passing"
64+ let warning = cwd </> "examples" </> "warning"
6465 let failing = cwd </> "examples" </> "failing"
6566 let supportDir = cwd </> "tests" </> "support" </> "bower_components"
6667 let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir
6768 passingFiles <- getTestFiles passing <$> testGlob passing
69+ warningFiles <- getTestFiles warning <$> testGlob warning
6870 failingFiles <- getTestFiles failing <$> testGlob failing
6971 supportPurs <- supportFiles "purs"
7072 supportPursFiles <- readInput supportPurs
7173 supportExterns <- runExceptT $ do
7274 modules <- ExceptT . return $ P.parseModulesFromFiles id supportPursFiles
7375 foreigns <- inferForeignModules modules
74− externs <- ExceptT . runTest $ P.make (makeActions foreigns) (map snd modules)
76+ externs <- ExceptT . fmap fst . runTest $ P.make (makeActions foreigns) (map snd modules)
7577 return (zip (map snd modules) externs)
7678 case supportExterns of
7779 Left errs -> fail (P.prettyPrintMultipleErrors False errs)
78− Right externs -> return (externs, passingFiles, failingFiles)
80+ Right externs -> return (externs, passingFiles, warningFiles, failingFiles)
7981
80− context ("Passing examples") $ do
82+ context "Passing examples" $
8183 forM_ passingTestCases $ \testPurs ->
8284 it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile and run without error") $
8385 assertCompiles supportExterns testPurs
8486
85− context ("Failing examples") $ do
87+ context "Warning examples" $
88+ forM_ warningTestCases $ \testPurs -> do
89+ let mainPath = getTestMain testPurs
90+ expectedWarnings <- runIO $ getShouldWarnWith mainPath
91+ it ("'" <> takeFileName mainPath <> "' should compile with warning(s) '" <> intercalate "', '" expectedWarnings <> "'") $
92+ assertCompilesWithWarnings supportExterns testPurs expectedWarnings
93+
94+ context "Failing examples" $
8695 forM_ failingTestCases $ \testPurs -> do
8796 let mainPath = getTestMain testPurs
8897 expectedFailures <- runIO $ getShouldFailWith mainPath
@@ -100,8 +109,7 @@ spec = do
100109 -- .purs files and the .js files for the test case.
101110 getTestFiles :: FilePath -> [FilePath] -> [[FilePath]]
102111 getTestFiles baseDir
103− = map (filter ((== ".purs") . takeExtensions))
104− . map (map (baseDir </>))
112+ = map (filter ((== ".purs") . takeExtensions) . map (baseDir </>))
105113 . groupBy ((==) `on` extractPrefix)
106114 . sortBy (compare `on` extractPrefix)
107115 . map (makeRelative baseDir)
@@ -110,7 +118,7 @@ spec = do
110118 -- by the file with the shortest path name, as everything but the main file
111119 -- will be under a subdirectory.
112120 getTestMain :: [FilePath] -> FilePath
113− getTestMain = head . sortBy (compare `on` length)
121+ getTestMain = minimumBy (compare `on` length)
114122
115123 -- Extracts the filename part of a .purs file, or if the file is in a
116124 -- subdirectory, the first part of that directory path.
@@ -125,9 +133,17 @@ spec = do
125133 -- Scans a file for @shouldFailWith directives in the comments, used to
126134 -- determine expected failures
127135 getShouldFailWith :: FilePath -> IO [String]
128− getShouldFailWith = fmap extractFailWiths . readUTF8File
136+ getShouldFailWith = extractPragma "shouldFailWith"
137+
138+ -- Scans a file for @shouldWarnWith directives in the comments, used to
139+ -- determine expected warnings
140+ getShouldWarnWith :: FilePath -> IO [String]
141+ getShouldWarnWith = extractPragma "shouldWarnWith"
142+
143+ extractPragma :: String -> FilePath -> IO [String]
144+ extractPragma pragma = fmap go . readUTF8File
129145 where
130− extractFailWiths = lines >>> mapMaybe (stripPrefix "-- @shouldFailWith ") >>> map trim
146+ go = lines >>> mapMaybe (stripPrefix ("-- @" ++ pragma ++ " ")) >>> map trim
131147
132148inferForeignModules
133149 :: MonadIO m
@@ -168,16 +184,14 @@ readInput inputFiles = forM inputFiles $ \inputFile -> do
168184 text <- readUTF8File inputFile
169185 return (inputFile, text)
170186
171−type TestM = WriterT [(FilePath, String)] IO
172−
173−runTest :: P.Make a -> IO (Either P.MultipleErrors a)
174−runTest = fmap fst . P.runMake P.defaultOptions
187+runTest :: P.Make a -> IO (Either P.MultipleErrors a, P.MultipleErrors)
188+runTest = P.runMake P.defaultOptions
175189
176190compile
177191 :: [(P.Module, P.ExternsFile)]
178192 -> [FilePath]
179193 -> ([P.Module] -> IO ())
180− -> IO (Either P.MultipleErrors [P.ExternsFile])
194+ -> IO (Either P.MultipleErrors [P.ExternsFile], P.MultipleErrors)
181195compile supportExterns inputFiles check = silence $ runTest $ do
182196 fs <- liftIO $ readInput inputFiles
183197 ms <- P.parseModulesFromFiles id fs
@@ -192,18 +206,30 @@ assert
192206 :: [(P.Module, P.ExternsFile)]
193207 -> [FilePath]
194208 -> ([P.Module] -> IO ())
195− -> (Either P.MultipleErrors [P.ExternsFile] -> IO (Maybe String))
209+ -> (Either P.MultipleErrors P.MultipleErrors -> IO (Maybe String))
196210 -> Expectation
197211assert supportExterns inputFiles check f = do
198− e <- compile supportExterns inputFiles check
199− maybeErr <- f e
212+ (e, w) <- compile supportExterns inputFiles check
213+ maybeErr <- f (const w <$> e)
200214 maybe (return ()) expectationFailure maybeErr
201215
216+checkMain :: [P.Module] -> IO ()
217+checkMain ms =
218+ unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)
219+ (fail "Main module missing")
220+
221+checkShouldFailWith :: [String] -> P.MultipleErrors -> Maybe String
222+checkShouldFailWith expected errs =
223+ let actual = map P.errorCode $ P.runMultipleErrors errs
224+ in if sort expected == sort actual
225+ then Nothing
226+ else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual
227+
202228assertCompiles
203229 :: [(P.Module, P.ExternsFile)]
204230 -> [FilePath]
205231 -> Expectation
206−assertCompiles supportExterns inputFiles = do
232+assertCompiles supportExterns inputFiles =
207233 assert supportExterns inputFiles checkMain $ \e ->
208234 case e of
209235 Left errs -> return . Just . P.prettyPrintMultipleErrors False $ errs
@@ -219,17 +245,32 @@ assertCompiles supportExterns inputFiles = do
219245 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out
220246 Just (ExitFailure _, _, err) -> return $ Just err
221247 Nothing -> return $ Just "Couldn't find node.js executable"
248+
249+assertCompilesWithWarnings
250+ :: [(P.Module, P.ExternsFile)]
251+ -> [FilePath]
252+ -> [String]
253+ -> Expectation
254+assertCompilesWithWarnings supportExterns inputFiles shouldWarnWith =
255+ assert supportExterns inputFiles checkMain $ \e ->
256+ case e of
257+ Left errs ->
258+ return . Just . P.prettyPrintMultipleErrors False $ errs
259+ Right warnings ->
260+ return
261+ . fmap (printAllWarnings warnings)
262+ $ checkShouldFailWith shouldWarnWith warnings
263+
222264 where
223− checkMain ms =
224− unless (any ((== P.moduleNameFromString "Main") . P.getModuleName) ms)
225− (fail "Main module missing")
265+ printAllWarnings warnings =
266+ (<> "\n\n" <> P.prettyPrintMultipleErrors False warnings)
226267
227268assertDoesNotCompile
228269 :: [(P.Module, P.ExternsFile)]
229270 -> [FilePath]
230271 -> [String]
231272 -> Expectation
232−assertDoesNotCompile supportExterns inputFiles shouldFailWith = do
273+assertDoesNotCompile supportExterns inputFiles shouldFailWith =
233274 assert supportExterns inputFiles noPreCheck $ \e ->
234275 case e of
235276 Left errs ->
@@ -243,9 +284,3 @@ assertDoesNotCompile supportExterns inputFiles shouldFailWith = do
243284
244285 where
245286 noPreCheck = const (return ())
246−
247− checkShouldFailWith expected errs =
248− let actual = map P.errorCode $ P.runMultipleErrors errs
249− in if sort expected == sort actual
250− then Nothing
251− else Just $ "Expected these errors: " ++ show expected ++ ", but got these: " ++ show actual