diff --git a/tests/ghc-regress/codeGen/should_run/all.T b/tests/ghc-regress/codeGen/should_run/all.T index 48bb06c670c2dfb41f5dbda541cc485bb84a9cf6..e0322cbb482a8c8cdc524530dca2aa9ec46b9176 100644 --- a/tests/ghc-regress/codeGen/should_run/all.T +++ b/tests/ghc-regress/codeGen/should_run/all.T @@ -72,6 +72,7 @@ test('cgrun061', normal, compile_and_run, ['']) test('cgrun062', normal, compile_and_run, ['']) test('cgrun063', normal, compile_and_run, ['']) test('cgrun065', normal, compile_and_run, ['']) +test('cgrun066', normal, compile_and_run, ['']) test('1861', extra_run_opts('0'), compile_and_run, ['']) diff --git a/tests/ghc-regress/codeGen/should_run/cgrun066.hs b/tests/ghc-regress/codeGen/should_run/cgrun066.hs new file mode 100644 index 0000000000000000000000000000000000000000..aa1c621d712eb6d50ff1fd65256fc2dfdb76b2c2 --- /dev/null +++ b/tests/ghc-regress/codeGen/should_run/cgrun066.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} +{-# OPTIONS_GHC -O0 #-} + +import Foreign.C +import Data.Word +import Foreign.Ptr +import GHC.Exts + +import Control.Exception + +hashStr :: Ptr Word8 -> Int -> Int +hashStr (Ptr a#) (I# len#) = loop 0# 0# + where + loop h n | n GHC.Exts.==# len# = I# h + | otherwise = loop h2 (n GHC.Exts.+# 1#) + where !c = ord# (indexCharOffAddr# a# n) + !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#` 4091# + +-- Infinite loops with new code generator + C-- optimizations +main = do + withCStringLen "ff" $ \(ptr, l) -> do + print (hashStr (castPtr ptr) l) diff --git a/tests/ghc-regress/codeGen/should_run/cgrun066.stdout b/tests/ghc-regress/codeGen/should_run/cgrun066.stdout new file mode 100644 index 0000000000000000000000000000000000000000..b9cb48f6e45c89371fa65e341a1b3a72aa6aee29 --- /dev/null +++ b/tests/ghc-regress/codeGen/should_run/cgrun066.stdout @@ -0,0 +1 @@ +885 diff --git a/tests/ghc-regress/ffi/should_run/all.T b/tests/ghc-regress/ffi/should_run/all.T index f43dc3a682bff06fe6e1ec9d0e29da69c9a9870e..434397d065474b975f21ab552f967c6a5021c876 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 0000000000000000000000000000000000000000..dab4cad1d1f978f8004378f3df1e7790696200bd --- /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 0000000000000000000000000000000000000000..fa5f27d44982145fa12531b4b294d21d6e7134c0 --- /dev/null +++ b/tests/ghc-regress/ffi/should_run/ffi022.stdout @@ -0,0 +1 @@ +"ffi022" diff --git a/tests/ghc-regress/ghc-e/should_run/all.T b/tests/ghc-regress/ghc-e/should_run/all.T index b4aec446c4cd25be5e1282087edf1885485d40a4..bedaaa1f2993b5f98b37e0482635283d553b212a 100644 --- a/tests/ghc-regress/ghc-e/should_run/all.T +++ b/tests/ghc-regress/ghc-e/should_run/all.T @@ -6,10 +6,7 @@ test('ghc-e002', normal, run_command, ['$MAKE --no-print-directory -s ghc-e002'] test('ghc-e003', normal, run_command, ['$MAKE --no-print-directory -s ghc-e003']) test('ghc-e004', normal, run_command, ['$MAKE --no-print-directory -s ghc-e004']) test('ghc-e005', normal, run_command, ['$MAKE --no-print-directory -s ghc-e005']) -test('2228', - if_platform('i386-unknown-mingw32', expect_broken(2628)), - run_command, - ['$MAKE --no-print-directory -s 2228']) -test('2636', normal, run_command, ['$MAKE --no-print-directory -s 2636']) +test('2228', normal, run_command, ['$MAKE --no-print-directory -s 2228']) +test('2636', normal, run_command, ['$MAKE --no-print-directory -s 2636']) test('3890', normal, run_command, ['$MAKE --no-print-directory -s 3890'])