keel-dyn-0.1.0.0: test/Main.hs
-- | Smoke tests: real dlopen/resolve/call round-trip on each OS, the
-- negative paths (missing library, missing symbol), and the
-- "Keel.Dyn.Locate" search-order contract.
module Main (main) where
import Control.Exception (try)
import Control.Monad (unless)
import Data.Word (Word64)
import Foreign.Ptr (FunPtr)
import System.Environment (lookupEnv, setEnv, unsetEnv)
import System.FilePath ((</>))
import System.Info (os)
import Keel.Dyn
import Keel.Dyn.Locate
foreign import ccall "dynamic" mkTick :: FunPtr (IO Word64) -> IO Word64
foreign import ccall "dynamic" mkCos :: FunPtr (Double -> Double) -> Double -> Double
orDie :: Show e => String -> Either e a -> IO a
orDie ctx = either (\e -> fail (ctx <> ": " <> show e)) pure
expect :: Bool -> String -> IO ()
expect ok msg = unless ok (fail msg)
testEnvVar :: String
testEnvVar = "KEEL_DYN_TEST_LIB"
-- The spec name is chosen so its per-user data dir cannot exist, keeping
-- the data-dir stage of locateLibrary an empty pass-through in this test.
mkSpec :: [FilePath] -> LibrarySpec
mkSpec cands = LibrarySpec
{ specName = "keel-dyn-smoke-zzz"
, specEnvVar = testEnvVar
, specCandidates = cands
}
main :: IO ()
main = do
let (libName, symName) = case os of
"mingw32" -> ("kernel32.dll", "GetTickCount64")
"darwin" -> ("/usr/lib/libSystem.B.dylib", "cos")
_ -> ("libm.so.6", "cos")
-- 1. positive path: load, resolve (via requireSym), call through the
-- FunPtr. The resolve happens inside each branch because the FunPtr
-- type differs per OS.
lib <- orDie ("load " <> libName) =<< loadLibrary libName
case os of
"mingw32" -> do
fp <- requireSym lib symName
t <- mkTick fp
expect (t > 0) "GetTickCount64 returned 0"
_ -> do
fp <- requireSym lib symName
expect (abs (mkCos fp 0 - 1) < 1e-12) "cos 0 /= 1"
-- 2. negative path: a library that cannot exist
neg <- loadLibrary "keel-definitely-missing-library-zzz"
expect (either (const True) (const False) neg) "bogus library loaded"
-- 3. negative path: a symbol that cannot exist, through both interfaces
msym <- resolveOptional lib "keel_definitely_missing_symbol_zzz"
:: IO (Maybe (FunPtr ()))
expect (maybe True (const False) msym) "bogus symbol resolved"
thrown <- try (requireSym lib "keel_definitely_missing_symbol_zzz")
:: IO (Either DynError (FunPtr ()))
case thrown of
Left (SymbolNotFound _ _) -> pure ()
Left e -> fail ("requireSym threw the wrong error: " <> show e)
Right _ -> fail "requireSym resolved a bogus symbol"
-- 4. locate: with no override and no data dir, the system-search stage
-- must find the library under its bare name (absolute on darwin).
unsetEnv testEnvVar
l1 <- orDie "locate via system search" =<< locateLibrary (mkSpec [libName])
expect (locOrigin l1 == FromSystem libName)
("wrong origin: " <> show (locOrigin l1))
closeLibrary (locLibrary l1)
-- 5. locate: a broken explicit override must FAIL, never fall through
-- to the system search (where the candidate would have resolved).
setEnv testEnvVar ("keel-no-such-dir-zzz" </> "keel-no-such-lib-zzz")
l2 <- locateLibrary (mkSpec [libName])
expect (either (const True) (const False) l2)
"broken override fell through to system search"
unsetEnv testEnvVar
-- 6. locate: env-file and env-dir overrides. Windows-only because only
-- there is the system library's absolute location derivable portably
-- (%SystemRoot%\System32); POSIX paths vary per distro and are covered
-- by the publish-stage CI matrix instead.
case os of
"mingw32" -> do
mroot <- lookupEnv "SystemRoot"
case mroot of
Nothing -> fail "SystemRoot unset; cannot exercise env override"
Just root -> do
let sys32 = root </> "System32"
k32 = sys32 </> "kernel32.dll"
setEnv testEnvVar k32
l3 <- orDie "locate via env file" =<< locateLibrary (mkSpec ["kernel32.dll"])
expect (locOrigin l3 == FromEnvFile k32)
("wrong origin: " <> show (locOrigin l3))
closeLibrary (locLibrary l3)
setEnv testEnvVar sys32
l4 <- orDie "locate via env dir" =<< locateLibrary (mkSpec ["kernel32.dll"])
expect (locOrigin l4 == FromEnvDir k32)
("wrong origin: " <> show (locOrigin l4))
closeLibrary (locLibrary l4)
unsetEnv testEnvVar
_ -> pure ()
closeLibrary lib
putStrLn "keel-dyn: all smoke tests passed"