Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2498ed494cb6405a437046e8674ead254c6e5f64 >--------------------------------------------------------------- commit 2498ed494cb6405a437046e8674ead254c6e5f64 Author: Edward Z. Yang <[email protected]> Date: Thu Apr 7 16:17:35 2011 +0100 Test for getProgName. Signed-off-by: Edward Z. Yang <[email protected]> >--------------------------------------------------------------- tests/ghc-regress/ffi/should_run/all.T | 2 + tests/ghc-regress/ffi/should_run/ffi022.hs | 35 ++++++++++++++++++++++++ tests/ghc-regress/ffi/should_run/ffi022.stdout | 1 + 3 files changed, 38 insertions(+), 0 deletions(-) diff --git a/tests/ghc-regress/ffi/should_run/all.T b/tests/ghc-regress/ffi/should_run/all.T index f43dc3a..434397d 100644 --- a/tests/ghc-regress/ffi/should_run/all.T +++ b/tests/ghc-regress/ffi/should_run/all.T @@ -153,6 +153,8 @@ test('ffi020', [ omit_ways(prof_ways), test('ffi021', normal, compile_and_run, ['']) +test('ffi022', normal, compile_and_run, ['']) + if config.platform == 'i386-unknown-mingw32': # This test needs a larger C stack than we get by default on Windows flagsFor4038 = ['-optl-Wl,--stack,10485760'] diff --git a/tests/ghc-regress/ffi/should_run/ffi022.hs b/tests/ghc-regress/ffi/should_run/ffi022.hs new file mode 100644 index 0000000..dab4cad --- /dev/null +++ b/tests/ghc-regress/ffi/should_run/ffi022.hs @@ -0,0 +1,35 @@ +{-# 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 _ = False + +foreign import ccall unsafe "getProgArgv" + getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO () + +main :: IO () +main = print =<< getProgName diff --git a/tests/ghc-regress/ffi/should_run/ffi022.stdout b/tests/ghc-regress/ffi/should_run/ffi022.stdout new file mode 100644 index 0000000..fa5f27d --- /dev/null +++ b/tests/ghc-regress/ffi/should_run/ffi022.stdout @@ -0,0 +1 @@ +"ffi022" _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
