1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
import Control.Monad (unless)
import System.Environment (executablePath, getArgs)
import System.Directory (removeFile, getCurrentDirectory)
import System.FilePath ((</>), dropExtension)
import System.Exit (exitSuccess, die)
canQuery, canDelete :: [String]
canQuery = ["mingw32", "freebsd", "linux", "darwin"]
canDelete = ["freebsd", "linux", "darwin"]
main :: IO ()
main = do
-- If executablePath = Nothing, then this platform
-- cannot return the executable path. So just exit
-- with a success value.
[os] <- getArgs
query <- case (os `elem` canQuery, executablePath) of
(False, Nothing) -> exitSuccess -- no query, as expected
(False, Just _) -> die "executablePath unexpectedly defined; this test needs an update!"
(True, Nothing) -> die "executablePath unexpected not defined"
(True, Just k) -> pure k
-- At this point, the query should return the path to the test program.
before <- query >>= \r -> case r of
Nothing
-> die "executablePath query unexpected returned Nothing"
Just path
-> pure path
cwd <- getCurrentDirectory
let
-- On some platforms the executable has a file extension
-- (e.g. ".exe" on Windows). Drop the extension when comparing.
expected = cwd </> "executablePath"
actual = dropExtension before
unless (actual == expected) $
die $ "executablePath query returned `" <> actual <> "`; expected `" <> expected <> "`"
unless (os `elem` canDelete)
-- This OS cannot delete the executable file while it is
-- still being executed. There is nothing left to test.
exitSuccess
-- Remove the file
removeFile before
-- Now query should return Nothing
after <- query
unless (after == Nothing) $ die $
"executablePath expected to return Nothing, returned " <> show after
|
