failing test

Author: noisyscanner

tests/TestCompiler.hs

@@ -46,7 +46,8 @@ import System.IO.UTF8 (readUTF8File)
 import Text.Regex.Base (RegexContext(..), RegexMaker(..))
 import Text.Regex.TDFA (Regex)
 
-import TestUtils (ExpectedModuleName(..), SupportModules, compile, createOutputFile, getTestFiles, goldenVsString, modulesDir, trim)
+import Data.Set qualified as S
+import TestUtils (ExpectedModuleName(..), SupportModules, compile, compile', createOutputFile, getTestFiles, goldenVsString, modulesDir, trim)
 import Test.Hspec (Expectation, SpecWith, beforeAllWith, describe, expectationFailure, it, runIO)
 
 spec :: SpecWith SupportModules
@@ -134,7 +135,11 @@ assertCompiles
   -> Handle
   -> Expectation
 assertCompiles support inputFiles outputFile = do
-  (fileContents, (result, _)) <- compile (Just IsMain) support inputFiles
+  extraFfiExts <- getFfiExts (getTestMain inputFiles)
+  let opts = if null extraFfiExts
+        then P.defaultOptions
+        else P.defaultOptions { P.optionsFFIExts = S.fromList extraFfiExts `S.union` P.optionsFFIExts P.defaultOptions }
+  (fileContents, (result, _)) <- compile' opts (Just IsMain) support inputFiles
   let errorOptions = P.defaultPPEOptions { P.ppeFileContents = fileContents }
   case result of
     Left errs -> expectationFailure . P.prettyPrintMultipleErrors errorOptions $ errs
@@ -253,6 +258,11 @@ getShouldFailWith = extractPragma "shouldFailWith"
 getShouldWarnWith :: FilePath -> IO [String]
 getShouldWarnWith = extractPragma "shouldWarnWith"
 
+-- Scans a file for @ffiExts directives in the comments, used to
+-- determine additional FFI file extensions for the test
+getFfiExts :: FilePath -> IO [String]
+getFfiExts = extractPragma "ffiExts"
+
 extractPragma :: String -> FilePath -> IO [String]
 extractPragma pragma = fmap go . readUTF8File
   where

tests/TestUtils.hs

@@ -21,6 +21,7 @@ import Data.Char (isSpace)
 import Data.Function (on)
 import Data.List (sort, sortBy, stripPrefix, groupBy, find)
 import Data.Map qualified as M
+import Data.Set (Set)
 import Data.Maybe (isJust)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
@@ -146,7 +147,7 @@ setupSupportModules = do
   ms <- getSupportModuleTuples
   let modules = map snd ms
   supportExterns <- runExceptT $ do
-    foreigns <- inferForeignModules ms
+    foreigns <- inferForeignModules (P.optionsFFIExts P.defaultOptions) ms
     externs <- ExceptT . fmap fst . runTest $ P.make (makeActions modules foreigns) (CST.pureResult <$> modules)
     return (externs, foreigns)
   case supportExterns of
@@ -204,7 +205,7 @@ compile' options expectedModule SupportModules{..} inputFiles = do
     msWithWarnings <- CST.parseFromFiles id fs
     tell $ foldMap (\(fp, (ws, _)) -> CST.toMultipleWarnings fp ws) msWithWarnings
     let ms = fmap snd <$> msWithWarnings
-    foreigns <- inferForeignModules ms
+    foreigns <- inferForeignModules (P.optionsFFIExts options) ms
     let
       actions = makeActions supportModules (foreigns `M.union` supportForeigns)
       (hasExpectedModuleName, expectedModuleName, compiledModulePath) = case expectedModule of
@@ -263,9 +264,10 @@ runTest = P.runMake P.defaultOptions
 
 inferForeignModules
   :: MonadIO m
-  => [(FilePath, P.Module)]
+  => Set String
+  -> [(FilePath, P.Module)]
   -> m (M.Map P.ModuleName FilePath)
-inferForeignModules = P.inferForeignModules (P.optionsFFIExts P.defaultOptions) . fromList
+inferForeignModules exts = P.inferForeignModules exts . fromList
   where
     fromList :: [(FilePath, P.Module)] -> M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
     fromList = M.fromList . map ((P.getModuleName *** Right) . swap)

tests/purs/failing/MissingFFIModuleUnknownExt.purs

@@ -0,0 +1,6 @@
+-- @shouldFailWith MissingFFIModule
+module Main where
+
+foreign import greeting :: String
+
+main = greeting

tests/purs/failing/MissingFFIModuleUnknownExt.ts

@@ -0,0 +1 @@
+export const greeting = "hello";

tests/purs/passing/TSFFI.purs

@@ -1,3 +1,4 @@
+-- @ffiExts ts
 module Main where
 
 import Prelude