1 files changed, 36 insertions, 0 deletions
diff --git a/testsuite/tests/ffi/should_run/ffi022.hs b/testsuite/tests/ffi/should_run/ffi022.hs
new file mode 100644
index 0000000000..5313f7183e
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/ffi022.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Foreign.C
+import Foreign
+
+getProgName :: IO String
+getProgName =
+  alloca $ \ p_argc ->
+  alloca $ \ p_argv -> do
+     getProgArgv p_argc p_argv
+     argv <- peek p_argv
+     unpackProgName argv
+
+unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
+unpackProgName argv = do
+  s <- peekElemOff argv 0 >>= peekCString
+  return (basename s)
+  where
+   basename :: String -> String
+   basename f = go f f
+    where
+      go acc [] = acc
+      go acc (x:xs)
+        | isPathSeparator x = go xs xs
+        | otherwise         = go acc xs
+
+   isPathSeparator :: Char -> Bool
+   isPathSeparator '/'  = True
+   isPathSeparator '\\' = True
+   isPathSeparator _    = False
+
+foreign import ccall unsafe "getProgArgv"
+  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
+
+main :: IO ()
+main = print =<< getProgName