summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFraser Tweedale <frase@frase.id.au>2021-06-21 21:20:48 +1000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-07-06 13:36:46 -0400
commita4e742c5157f268781761553496e8e37e3f00ab5 (patch)
tree9bef605c528a4016e1aa20cecd84660da0d71d8b
parent4b4c5e43ab40d277f18af86db049223fdf55fa59 (diff)
downloadhaskell-a4e742c5157f268781761553496e8e37e3f00ab5.tar.gz
Add test for executablePath
-rw-r--r--testsuite/tests/lib/base/all.T3
-rw-r--r--testsuite/tests/lib/base/executablePath.hs49
2 files changed, 51 insertions, 1 deletions
diff --git a/testsuite/tests/lib/base/all.T b/testsuite/tests/lib/base/all.T
index 170bfe4d85..e92af6d57c 100644
--- a/testsuite/tests/lib/base/all.T
+++ b/testsuite/tests/lib/base/all.T
@@ -3,4 +3,5 @@ test('T16586', normal, compile_and_run, ['-O2'])
# Event-manager not supported on Windows
test('T16916', when(opsys('mingw32'), skip), compile_and_run, ['-O2 -threaded -with-rtsopts="-I0" -rtsopts'])
test('T17310', normal, compile, [''])
-test('T19691', normal, compile, ['']) \ No newline at end of file
+test('T19691', normal, compile, [''])
+test('executablePath', extra_run_opts(config.os), compile_and_run, [''])
diff --git a/testsuite/tests/lib/base/executablePath.hs b/testsuite/tests/lib/base/executablePath.hs
new file mode 100644
index 0000000000..f60227e0ed
--- /dev/null
+++ b/testsuite/tests/lib/base/executablePath.hs
@@ -0,0 +1,49 @@
+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
+ cwd <- getCurrentDirectory
+
+ -- 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. On some platforms this may have a file
+ -- extension (e.g. ".exe" on Windows). Drop the extension
+ -- and compare to the expected path.
+ let expected = cwd </> "executablePath"
+ before <- fmap (fmap dropExtension) query >>= \r -> case r of
+ Nothing
+ -> die "executablePath query unexpected returned Nothing"
+ Just path | path /= expected
+ -> die $ "executablePath query returned `" <> path <> "`; expected `" <> expected <> "`"
+ Just path
+ -> pure path
+
+ 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