diff options
| author | Kavon Farvardin <kavon@farvard.in> | 2018-09-23 15:29:37 -0500 |
|---|---|---|
| committer | Kavon Farvardin <kavon@farvard.in> | 2018-09-23 15:29:37 -0500 |
| commit | 84c2ad99582391005b5e873198b15e9e9eb4f78d (patch) | |
| tree | caa8c2f2ec7e97fbb4977263c6817c9af5025cf4 /testsuite/tests/rts | |
| parent | 8ddb47cfcf5776e9a3c55fd37947c8a95e00fa12 (diff) | |
| parent | e68b439fe5de61b9a2ca51af472185c62ccb8b46 (diff) | |
| download | haskell-wip/T13904.tar.gz | |
update to current master againwip/T13904
Diffstat (limited to 'testsuite/tests/rts')
55 files changed, 435 insertions, 44 deletions
diff --git a/testsuite/tests/rts/InternalCounters.stdout b/testsuite/tests/rts/InternalCounters.stdout new file mode 100644 index 0000000000..d764d7bc19 --- /dev/null +++ b/testsuite/tests/rts/InternalCounters.stdout @@ -0,0 +1 @@ +Internal Counters:
\ No newline at end of file diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile index a6d248201b..bf7e163cf3 100644 --- a/testsuite/tests/rts/Makefile +++ b/testsuite/tests/rts/Makefile @@ -48,13 +48,13 @@ T5423: .PHONY: T9405 T9405: @'$(TEST_HC)' $(TEST_HC_OPTS) -ticky -rtsopts T9405.hs; \ - ./T9405 +RTS -rT9405.ticky & \ - sleep 0.2; \ - kill -2 $$!; \ - wait $$!; \ - [ -e T9405.ticky ] || echo "Error: Ticky profile doesn't exist"; \ - [ -s T9405.ticky ] || echo "Error: Ticky profile is empty"; \ - echo Ticky-Ticky; + ./T9405 +RTS -rT9405.ticky & \ + sleep 0.2; \ + kill -2 $$!; \ + wait $$!; \ + [ -e T9405.ticky ] || echo "Error: Ticky profile doesn't exist"; \ + [ -s T9405.ticky ] || echo "Error: Ticky profile is empty"; \ + echo Ticky-Ticky; # Naming convention: 'T5423_' obj-way '_' obj-src # obj-way ::= v | dyn @@ -64,7 +64,7 @@ T9405: define run_T5435_v $(RM) T5435_load_v_$(1) T5435_v_$(1)$(exeext) -'$(TEST_HC)' $(TEST_HC_OPTS) -optc-D$(HostOS)_HOST_OS -v0 -c T5435_$(1).c -o T5435_load_v_$(1).o +'$(TEST_HC)' $(TEST_HC_OPTS) -optc-D$(HostOS)_HOST_OS -optc-DLOAD_CONSTR=$(2) -v0 -c T5435_$(1).c -o T5435_load_v_$(1).o '$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf main_v_$(1)_o -o T5435_v_$(1)$(exeext) ./T5435_v_$(1) v ./T5435_load_v_$(1).o endef @@ -78,11 +78,13 @@ endef .PHONY: T5435_v_gcc T5435_v_gcc : - $(call run_T5435_v,gcc) + $(call run_T5435_v,gcc,0) -.PHONY: T5435_v_asm -T5435_v_asm : - $(call run_T5435_v,asm) +.PHONY: T5435_v_asm_a T5435_v_asm_b +T5435_v_asm_a : + $(call run_T5435_v,asm,0) +T5435_v_asm_b : + $(call run_T5435_v,asm,1) .PHONY: T5435_dyn_gcc T5435_dyn_gcc : @@ -174,3 +176,17 @@ T11788: .PHONY: T12497 T12497: echo main | "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) T12497.hs + +.PHONY: T13617 +T13617: + "$(TEST_CC)" -O3 -ffast-math -ftree-vectorize -c T13617.c -o T13617_sse.o + echo main | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T13617.hs T13617_sse.o + +.PHONY: T14695 +T14695: + echo ":quit" | LD_LIBRARY_PATH="foo:" "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) + +.PHONY: InternalCounters +InternalCounters: + "$(TEST_HC)" +RTS -s --internal-counters -RTS 2>&1 | grep "Internal Counters" + -"$(TEST_HC)" +RTS -s -RTS 2>&1 | grep "Internal Counters" diff --git a/testsuite/tests/rts/T13082/all.T b/testsuite/tests/rts/T13082/all.T index f048ce4ddd..9580bc40b8 100644 --- a/testsuite/tests/rts/T13082/all.T +++ b/testsuite/tests/rts/T13082/all.T @@ -1,7 +1,24 @@ +import string +import re + +#-------------------------------------- +# Python normalization functions +#-------------------------------------- + +def normalise_search_dirs (str): + str = re.sub(r"directories searched:\s+.+$", + r"directories searched: (none)", str, flags=re.MULTILINE) + str = re.sub(r"^\s+[A-Za-z]:[\\\/].+$", "", str, flags=re.MULTILINE) + return str + +#-------------------------------------- +# Test functions +#-------------------------------------- test('T13082_good', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), unless(opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory T13082_good']) -test('T13082_fail', [extra_files(['main.hs']), unless(opsys('mingw32'), skip)], +test('T13082_fail', [extra_files(['main.hs']), unless(opsys('mingw32'), skip), + normalise_errmsg_fun(normalise_search_dirs)], run_command, ['$MAKE -s --no-print-directory T13082_fail']) diff --git a/testsuite/tests/rts/T13617.c b/testsuite/tests/rts/T13617.c new file mode 100644 index 0000000000..6c9e714041 --- /dev/null +++ b/testsuite/tests/rts/T13617.c @@ -0,0 +1,8 @@ +int mult(int a[], int b[], int N) +{ + int sum = 0; + for(int i=0; i<N; i++){ + sum += a[i] + b[i]; + } + return sum; +} diff --git a/testsuite/tests/rts/T13617.hs b/testsuite/tests/rts/T13617.hs new file mode 100644 index 0000000000..b3c8b35dd3 --- /dev/null +++ b/testsuite/tests/rts/T13617.hs @@ -0,0 +1,15 @@ +module Main where + +import Foreign +import Foreign.Ptr +import Foreign.C + +import Foreign.Marshal.Array + +foreign import ccall unsafe "mult" mult :: Ptr CInt -> Ptr CInt + -> CInt -> IO CInt + +main = do res <- withArray [1..10] $ \a -> + withArray [5..15] $ \b -> + mult a b 10 + print res diff --git a/testsuite/tests/rts/T13617.stdout b/testsuite/tests/rts/T13617.stdout new file mode 100644 index 0000000000..fa8f08cb6f --- /dev/null +++ b/testsuite/tests/rts/T13617.stdout @@ -0,0 +1 @@ +150 diff --git a/testsuite/tests/rts/T14497.hs b/testsuite/tests/rts/T14497.hs new file mode 100644 index 0000000000..b6473f77c9 --- /dev/null +++ b/testsuite/tests/rts/T14497.hs @@ -0,0 +1,13 @@ +module Main (main) where + +import System.Timeout + +fuc :: Integer -> Integer +fuc 0 = 1 +fuc n = n * fuc (n - 1) + +main :: IO () +main = do + let x = fuc 30000 + timeout 1000 (print x) + print (x > 0) diff --git a/testsuite/tests/rts/T14497.stdout b/testsuite/tests/rts/T14497.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/rts/T14497.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/rts/T14611/Makefile b/testsuite/tests/rts/T14611/Makefile new file mode 100644 index 0000000000..4fc3f86ba5 --- /dev/null +++ b/testsuite/tests/rts/T14611/Makefile @@ -0,0 +1,10 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T14611: + '$(TEST_CC)' -c foo.c -o foo.o + '$(AR)' rsc libfoo.a foo.o + '$(TEST_HC)' -shared foo_dll.c -o libfoo-1.dll + mv libfoo-1.dll.a libfoo.dll.a + echo main | LIBRARY_PATH="$(PWD)" '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) main.hs -lfoo diff --git a/testsuite/tests/rts/T14611/T14611.stdout b/testsuite/tests/rts/T14611/T14611.stdout new file mode 100644 index 0000000000..d00491fd7e --- /dev/null +++ b/testsuite/tests/rts/T14611/T14611.stdout @@ -0,0 +1 @@ +1 diff --git a/testsuite/tests/rts/T14611/all.T b/testsuite/tests/rts/T14611/all.T new file mode 100644 index 0000000000..1387e6752d --- /dev/null +++ b/testsuite/tests/rts/T14611/all.T @@ -0,0 +1,4 @@ +test('T14611', + [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + unless(opsys('mingw32'), skip)], + run_command, ['$MAKE -s --no-print-directory T14611']) diff --git a/testsuite/tests/rts/T14611/foo.c b/testsuite/tests/rts/T14611/foo.c new file mode 100644 index 0000000000..af8ad9cb50 --- /dev/null +++ b/testsuite/tests/rts/T14611/foo.c @@ -0,0 +1,6 @@ +extern int bar(); + +int foo () +{ + return bar(); +} diff --git a/testsuite/tests/rts/T14611/foo_dll.c b/testsuite/tests/rts/T14611/foo_dll.c new file mode 100644 index 0000000000..8ea6c22735 --- /dev/null +++ b/testsuite/tests/rts/T14611/foo_dll.c @@ -0,0 +1,4 @@ +int foo() +{ + return 1; +} diff --git a/testsuite/tests/rts/T14611/main.hs b/testsuite/tests/rts/T14611/main.hs new file mode 100644 index 0000000000..fbc8f5603c --- /dev/null +++ b/testsuite/tests/rts/T14611/main.hs @@ -0,0 +1,5 @@ +module Main where + +foreign import ccall "foo" c_foo :: Int + +main = print c_foo diff --git a/testsuite/tests/rts/T14702.hs b/testsuite/tests/rts/T14702.hs new file mode 100644 index 0000000000..8e07529f47 --- /dev/null +++ b/testsuite/tests/rts/T14702.hs @@ -0,0 +1,36 @@ +module Main where + +import Control.Monad +import Data.Array.IO.Safe +import Data.Word +import GHC.Stats +import System.Exit +import System.Mem + +printAlloc :: String -> IO (Word64, Word64) +printAlloc name = do + performGC + details <- gc <$> getRTSStats + let dat = (gcdetails_live_bytes details, gcdetails_mem_in_use_bytes details) + putStrLn $ name ++ ": " ++ show dat + pure dat + +allocateAndPrint :: IO () +allocateAndPrint = do + -- allocate and touch a lot of memory (4MB * 260 ~ 1GB) + memoryHog <- forM [1 .. 300] $ \_ -> + (newArray (0, 1000000) 0 :: IO (IOUArray Word Word32)) + _ <- printAlloc "with large allocation" + -- do something with memory to prevent it from being GC'ed until now + forM_ memoryHog $ \a -> void $ readArray a 0 + +main :: IO () +main = do + (firstLive, firstTotal) <- printAlloc "initial" + allocateAndPrint + (lastLive, lastTotal) <- printAlloc "final" + + -- Now there is no reason to have more memory allocated than at start + let ratio = fromIntegral lastTotal / fromIntegral firstTotal + putStrLn $ "alloc ratio " ++ show ratio + when (ratio > 1.5) $ exitFailure diff --git a/testsuite/tests/rts/T14900.hs b/testsuite/tests/rts/T14900.hs new file mode 100644 index 0000000000..bd29289e19 --- /dev/null +++ b/testsuite/tests/rts/T14900.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Compact +import GHC.Int +import GHC.Prim +import GHC.IO +import GHC.Exts + +data BA = ByteArray ByteArray# + +newByteArray :: Int -> IO BA +newByteArray (I# sz) = IO $ \s -> case newByteArray# sz s of { + (# s', arr# #) -> case unsafeFreezeByteArray# arr# s of { + (# s'', barr# #) -> (# s', ByteArray barr# #) }} + +main :: IO () +main = do + ByteArray arr1# <- fmap getCompact $ newByteArray 65000 >>= compact + ByteArray arr2# <- newByteArray 65000 + print (I# (isByteArrayPinned# arr1#)) + print (I# (isByteArrayPinned# arr2#)) + putStrLn "Finished" diff --git a/testsuite/tests/rts/T14900.stdout b/testsuite/tests/rts/T14900.stdout new file mode 100644 index 0000000000..fdc259d094 --- /dev/null +++ b/testsuite/tests/rts/T14900.stdout @@ -0,0 +1,3 @@ +1 +1 +Finished diff --git a/testsuite/tests/rts/T15261/Makefile b/testsuite/tests/rts/T15261/Makefile new file mode 100644 index 0000000000..f50b22c282 --- /dev/null +++ b/testsuite/tests/rts/T15261/Makefile @@ -0,0 +1,11 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T15261a: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -with-rtsopts="-t -s" --make T15261a.hs + ./T15261a +RTS --info | grep "rtsopts" + +T15261b: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make T15261b.hs + ./T15261b +RTS --info | grep "rtsopts" diff --git a/testsuite/tests/rts/T15261/T15261a.hs b/testsuite/tests/rts/T15261/T15261a.hs new file mode 100644 index 0000000000..4c512dc9c1 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261a" diff --git a/testsuite/tests/rts/T15261/T15261a.stdout b/testsuite/tests/rts/T15261/T15261a.stdout new file mode 100644 index 0000000000..5919bb4bdd --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "-t -s") diff --git a/testsuite/tests/rts/T15261/T15261b.hs b/testsuite/tests/rts/T15261/T15261b.hs new file mode 100644 index 0000000000..1304a85c6d --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261b" diff --git a/testsuite/tests/rts/T15261/T15261b.stdout b/testsuite/tests/rts/T15261/T15261b.stdout new file mode 100644 index 0000000000..80184e82ab --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "") diff --git a/testsuite/tests/rts/T15261/all.T b/testsuite/tests/rts/T15261/all.T new file mode 100644 index 0000000000..5bc6977c26 --- /dev/null +++ b/testsuite/tests/rts/T15261/all.T @@ -0,0 +1,2 @@ +test('T15261a', normal, run_command, ['$MAKE -s --no-print-directory T15261a']) +test('T15261b', normal, run_command, ['$MAKE -s --no-print-directory T15261b']) diff --git a/testsuite/tests/rts/T5435_asm.c b/testsuite/tests/rts/T5435_asm.c index 59b53b1c3e..90813aa839 100644 --- a/testsuite/tests/rts/T5435_asm.c +++ b/testsuite/tests/rts/T5435_asm.c @@ -33,17 +33,19 @@ static void (*mod_init_func[2])(void) __attribute__(( #else /* ELF */ +#if LOAD_CONSTR == 0 static void (*const init_array[2])(void) __attribute__(( section(".init_array"), // put it in the right section used, // prevent GCC from optimizing this away aligned(sizeof(void*)) // avoid slop between GCC's preloaded initializers and ours )) = {initArray1, initArray2}; - +#else static void (*ctors[2])(void) __attribute__(( section(".ctors"), used, aligned(sizeof(void*)))) = {ctors2, ctors1}; // ctors run in reverse +#endif #endif diff --git a/testsuite/tests/rts/T5435_dyn_asm.stdout b/testsuite/tests/rts/T5435_dyn_asm.stdout index 1893d0f56a..429c314309 100644 --- a/testsuite/tests/rts/T5435_dyn_asm.stdout +++ b/testsuite/tests/rts/T5435_dyn_asm.stdout @@ -1,5 +1,3 @@ initArray1 initArray2 -ctors1 -ctors2 success diff --git a/testsuite/tests/rts/T5435_v_asm_a.stdout b/testsuite/tests/rts/T5435_v_asm_a.stdout new file mode 100644 index 0000000000..3124fa8559 --- /dev/null +++ b/testsuite/tests/rts/T5435_v_asm_a.stdout @@ -0,0 +1,3 @@ +initArray1 +initArray2 +success
\ No newline at end of file diff --git a/testsuite/tests/rts/T5435_v_asm.stdout-darwin b/testsuite/tests/rts/T5435_v_asm_a.stdout-darwin index 8827792585..8827792585 100644 --- a/testsuite/tests/rts/T5435_v_asm.stdout-darwin +++ b/testsuite/tests/rts/T5435_v_asm_a.stdout-darwin diff --git a/testsuite/tests/rts/T5435_v_asm.stdout-mingw32 b/testsuite/tests/rts/T5435_v_asm_a.stdout-mingw32 index 293bd12fb0..293bd12fb0 100644 --- a/testsuite/tests/rts/T5435_v_asm.stdout-mingw32 +++ b/testsuite/tests/rts/T5435_v_asm_a.stdout-mingw32 diff --git a/testsuite/tests/rts/T5435_v_asm_b.stdout b/testsuite/tests/rts/T5435_v_asm_b.stdout new file mode 100644 index 0000000000..318d66e12b --- /dev/null +++ b/testsuite/tests/rts/T5435_v_asm_b.stdout @@ -0,0 +1,3 @@ +ctors1 +ctors2 +success
\ No newline at end of file diff --git a/testsuite/tests/rts/T6006.stdout-mingw32 b/testsuite/tests/rts/T6006.stdout-mingw32 index 42e57fde57..962ec4b280 100644 --- a/testsuite/tests/rts/T6006.stdout-mingw32 +++ b/testsuite/tests/rts/T6006.stdout-mingw32 @@ -1,2 +1,2 @@ -"T6006.exe" +"T6006" [] diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index e81940479e..eb06dcc0c0 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -35,12 +35,12 @@ test('derefnull', when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(139)]), when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(139)]), when(platform('powerpc-apple-darwin'), [ignore_stderr, exit_code(139)]), - when(opsys('mingw32'), [exit_code(1), normalise_fun(normalise_address)]), + when(opsys('mingw32'), [ignore_stderr, exit_code(11)]), # since these test are supposed to crash the # profile report will be empty always. # so disable the check for profiling when(opsys('mingw32'), omit_ways(prof_ways))], - compile_and_run, ['']) + compile_and_run, ['-with-rtsopts="--generate-stack-traces=no"']) test('divbyzero', [# SIGFPE on Linux exit_code(136), @@ -54,7 +54,7 @@ test('divbyzero', # C programs compiled with gcc exit normally, so do we. when(platform('powerpc64-unknown-linux'), [ignore_stdout, exit_code(0)]), when(platform('powerpc64le-unknown-linux'), [ignore_stdout, exit_code(0)]), - when(opsys('mingw32'), exit_code(1)), + when(opsys('mingw32'), [ignore_stderr, exit_code(8)]), # The output under OS X is too unstable to readily compare when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(136)]), when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(136)]), @@ -63,7 +63,7 @@ test('divbyzero', # profile report will be empty always. # so disable the check for profiling when(opsys('mingw32'), omit_ways(prof_ways))], - compile_and_run, ['']) + compile_and_run, ['-with-rtsopts="--generate-stack-traces=no"']) test('outofmem', when(opsys('darwin'), skip), run_command, ['$MAKE -s --no-print-directory outofmem']) @@ -74,7 +74,9 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS')], # Blackhole-detection test. # Skip GHCi due to #2786 -test('T2783', [ omit_ways(['ghci']), exit_code(1) ], compile_and_run, ['']) +test('T2783', [ omit_ways(['ghci']), exit_code(1) + , expect_broken_for(2783, ['threaded1']) + ], compile_and_run, ['']) # Test the work-stealing deque implementation. We run this test in # both threaded1 (-threaded -debug) and threaded2 (-threaded) ways. @@ -97,6 +99,11 @@ test('stack003', [ omit_ways('ghci'), # uses unboxed tuples extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ], compile_and_run, ['']) +# Test that +RTS -K0 (e.g. no stack limit) parses correctly +test('stack004', [ extra_run_opts('+RTS -K0 -RTS') + , expect_broken_for(14913, ['ghci']) + ], compile_and_run, ['']) + test('atomicinc', [ c_src, only_ways(['normal','threaded1', 'threaded2']) ], compile_and_run, ['']) test('atomicxchg', [ c_src, only_ways(['threaded1', 'threaded2']) ], compile_and_run, ['']) @@ -128,10 +135,14 @@ test('T2615', # omit dyn and profiling ways, because we don't build dyn_l or p_l # variants of the RTS by default -test('traceEvent', [ omit_ways(['dyn'] + prof_ways), +test('traceEvent', [ omit_ways(['dyn', 'ghci'] + prof_ways), extra_run_opts('+RTS -ls -RTS') ], compile_and_run, ['-eventlog']) +test('traceBinaryEvent', [ omit_ways(['dyn', 'ghci'] + prof_ways), + extra_run_opts('+RTS -ls -RTS') ], + compile_and_run, ['-eventlog']) + test('T4059', [], run_command, ['$MAKE -s --no-print-directory T4059']) # Test for #4274 @@ -167,30 +178,34 @@ def checkDynAsm(actual_file, normaliser): actual_raw = read_no_crs(actual_file) actual_str = normaliser(actual_raw) actual = actual_str.split() - if actual == ['initArray1', 'initArray2', 'ctors1', 'ctors2', 'success']: - return 1 - elif actual == ['initArray1', 'initArray2', 'ctors2', 'ctors1', 'success']: - # gold seems to produce this ordering; this is slightly odd but if it's - # wrong it's not our fault. See #13883. - return 1 - elif actual == ['ctors1', 'ctors2', 'initArray1', 'initArray2', 'success']: - if_verbose(1, 'T5435_dyn_asm detected old-style dlopen, see #8458') - return 1 + if actual == ['initArray1', 'initArray2', 'success']: + return True elif opsys('darwin') and actual == ['modInitFunc1', 'modInitFunc2', 'success']: - return 1 + return True elif opsys('mingw32') and actual == ['ctors1', 'ctors2', 'success']: - return 1 + return True else: if_verbose(1, 'T5435_dyn_asm failed with %s, see all.T for details' % actual) - return 0 + return False +# T5435_v_asm got split into two tests because depending +# on the linker, .init_array and .ctors sections are loaded +# in a different order (but all entries within a section +# do get loaded in a deterministic order). So we test each +# separately now. # These should have extra_clean() arguments, but I need # to somehow extract out the name of DLLs to do that - -test('T5435_v_asm', [extra_files(['T5435.hs', 'T5435_asm.c']), +test('T5435_v_asm_a', [extra_files(['T5435.hs', 'T5435_asm.c']), when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))], - run_command, ['$MAKE -s --no-print-directory T5435_v_asm']) + run_command, ['$MAKE -s --no-print-directory T5435_v_asm_a']) +# this one just needs to run on linux, as darwin/mingw32 are covered +# by the _a test already. +test('T5435_v_asm_b', [extra_files(['T5435.hs', 'T5435_asm.c']), + when(arch('powerpc64') or arch('powerpc64le'), + expect_broken(11259)), + when(opsys('darwin') or opsys('mingw32'), skip)], + run_command, ['$MAKE -s --no-print-directory T5435_v_asm_b']) test('T5435_v_gcc', [extra_files(['T5435.hs', 'T5435_gcc.c']), when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))], @@ -293,7 +308,8 @@ test('ListStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['']) # 251 = RTS exit code for "out of memory" -test('overflow1', [ exit_code(251) ], compile_and_run, ['']) +test('overflow1', [ exit_code(251), when(wordsize(32), expect_broken(15255)) ], + compile_and_run, ['']) test('overflow2', [ exit_code(251) ], compile_and_run, ['']) test('overflow3', [ exit_code(251) ], compile_and_run, ['']) @@ -375,6 +391,43 @@ test('T12497', [ unless(opsys('mingw32'), skip) ], run_command, ['$MAKE -s --no-print-directory T12497']) -test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) +test('T13617', [ unless(opsys('mingw32'), skip)], + run_command, ['$MAKE -s --no-print-directory T13617']) + +# This test sometimes produces out of sequence samples in the profasm way, but +# not reliably, so we just skip it. See ticket #15065. +# Test is being skipped on darwin due to it's flakiness. +test('T12903', [ when(opsys('mingw32'), skip) + , when(opsys('darwin'), skip) + , omit_ways(['ghci', 'profasm'])] + , compile_and_run, ['']) + test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13894', normal, compile_and_run, ['']) +# this test fails with the profasm way on some machines but not others, +# so we just skip it. +test('T14497', [omit_ways(['profasm']), multi_cpu_race], compile_and_run, ['-O']) +test('T14695', [normal, ignore_stderr] + , run_command, ['$MAKE -s --no-print-directory T14695']) +test('T14702', [ ignore_stdout + , only_ways(['threaded1', 'threaded2']) + , extra_run_opts('+RTS -A32m -N8 -T -RTS') + ] + , compile_and_run, ['']) + +test('T14900', normal, compile_and_run, ['-package ghc-compact']) +test('InternalCounters', normal, run_command, + ['$MAKE -s --no-print-directory InternalCounters']) +test('alloccounter1', normal, compile_and_run, + [ + # avoid allocating stack chunks, which counts as + # allocation and messes up the results: + '-with-rtsopts=-k1m' + ]) + +test('nursery-chunks1', + [ extra_run_opts('4 100 +RTS -n32k -A1m -RTS') + , only_ways(['threaded1','threaded2']) + ], + compile_and_run, + ['']) diff --git a/testsuite/tests/rts/alloccounter1.hs b/testsuite/tests/rts/alloccounter1.hs new file mode 100644 index 0000000000..4b81896d2c --- /dev/null +++ b/testsuite/tests/rts/alloccounter1.hs @@ -0,0 +1,19 @@ +module Main where + +import Control.Exception +import Control.Monad +import Data.List +import System.Mem + +main = do + let + testAlloc n = do + let start = 999999 + setAllocationCounter start + evaluate (last [1..n]) + c <- getAllocationCounter + -- print (start - c) + return (start - c) + results <- forM [1..1000] testAlloc + print (sort results == results) + -- results better be in ascending order diff --git a/testsuite/tests/rts/alloccounter1.stdout b/testsuite/tests/rts/alloccounter1.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/rts/alloccounter1.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 b/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 deleted file mode 100644 index 4541b7fb28..0000000000 --- a/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -Access violation in generated code when reading ADDRESS diff --git a/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 b/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 deleted file mode 100644 index 4541b7fb28..0000000000 --- a/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -Access violation in generated code when reading ADDRESS diff --git a/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32 b/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32 deleted file mode 100644 index 466709b368..0000000000 --- a/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -divide by zero diff --git a/testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 b/testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 deleted file mode 100644 index 466709b368..0000000000 --- a/testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -divide by zero diff --git a/testsuite/tests/rts/flags/Makefile b/testsuite/tests/rts/flags/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/rts/flags/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/rts/flags/T12870.hs b/testsuite/tests/rts/flags/T12870.hs new file mode 100644 index 0000000000..69086cde2b --- /dev/null +++ b/testsuite/tests/rts/flags/T12870.hs @@ -0,0 +1,7 @@ +--We check if RTS arguments are properly filtered/passed along +--by outputting them to stdout. + +import System.Environment + +main :: IO () +main = getArgs >>= putStr . show diff --git a/testsuite/tests/rts/flags/T12870_.stdout b/testsuite/tests/rts/flags/T12870_.stdout new file mode 100644 index 0000000000..1b04d8a31c --- /dev/null +++ b/testsuite/tests/rts/flags/T12870_.stdout @@ -0,0 +1 @@ +Heap overflow caught! diff --git a/testsuite/tests/rts/flags/T12870a.stdout b/testsuite/tests/rts/flags/T12870a.stdout new file mode 100644 index 0000000000..495a52faf3 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870a.stdout @@ -0,0 +1 @@ +["arg1","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870c.stderr b/testsuite/tests/rts/flags/T12870c.stderr new file mode 100644 index 0000000000..0545774941 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870c.stderr @@ -0,0 +1 @@ +T12870c.exe: Most RTS options are disabled. Link with -rtsopts to enable them.
diff --git a/testsuite/tests/rts/flags/T12870d.stdout b/testsuite/tests/rts/flags/T12870d.stdout new file mode 100644 index 0000000000..495a52faf3 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870d.stdout @@ -0,0 +1 @@ +["arg1","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870e.stdout b/testsuite/tests/rts/flags/T12870e.stdout new file mode 100644 index 0000000000..4859ab454c --- /dev/null +++ b/testsuite/tests/rts/flags/T12870e.stdout @@ -0,0 +1 @@ +["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870f.stdout b/testsuite/tests/rts/flags/T12870f.stdout new file mode 100644 index 0000000000..4859ab454c --- /dev/null +++ b/testsuite/tests/rts/flags/T12870f.stdout @@ -0,0 +1 @@ +["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870g.hs b/testsuite/tests/rts/flags/T12870g.hs new file mode 100644 index 0000000000..3efd633ddd --- /dev/null +++ b/testsuite/tests/rts/flags/T12870g.hs @@ -0,0 +1,9 @@ +--We check the generation count as a way to verify an RTS argument +--was actually parsed and accepted by the RTS. + +import GHC.RTS.Flags (getGCFlags, generations) + +main :: IO () +main = do + gcFlags <- getGCFlags + putStr . show $ generations gcFlags diff --git a/testsuite/tests/rts/flags/T12870g.stdout b/testsuite/tests/rts/flags/T12870g.stdout new file mode 100644 index 0000000000..c7930257df --- /dev/null +++ b/testsuite/tests/rts/flags/T12870g.stdout @@ -0,0 +1 @@ +7
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870h.stdout b/testsuite/tests/rts/flags/T12870h.stdout new file mode 100644 index 0000000000..e440e5c842 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870h.stdout @@ -0,0 +1 @@ +3
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/all.T b/testsuite/tests/rts/flags/all.T new file mode 100644 index 0000000000..6d9368e2c1 --- /dev/null +++ b/testsuite/tests/rts/flags/all.T @@ -0,0 +1,53 @@ +# We ignore ways which depend on passing RTS arguments for simplicity and only +# run in normal way. + +# Standard handling of RTS arguments +test('T12870a', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts']) + +test('T12870b', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + exit_code(1), ignore_stderr, only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=none']) + +test('T12870c', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + exit_code(1), only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=some']) + +test('T12870d', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '']) + +# RTS options should be passed along to the program +test('T12870e', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=ignore']) + +test('T12870f', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=ignoreAll']) + +# Check handling of env variables +test('T12870g', + [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870g', '-rtsopts -with-rtsopts="-G3"']) + +test('T12870h', + [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870g', '-rtsopts=ignoreAll -with-rtsopts="-G3"']) diff --git a/testsuite/tests/rts/nursery-chunks1.hs b/testsuite/tests/rts/nursery-chunks1.hs new file mode 100644 index 0000000000..f8f9f6a7fa --- /dev/null +++ b/testsuite/tests/rts/nursery-chunks1.hs @@ -0,0 +1,12 @@ +-- Test for a bug that provoked the following assertion failure: +-- nursery-chunks1: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 903 +module Main (main) where + +import Control.Monad +import System.Environment +import GHC.Conc + +main = do + [n,m] <- fmap read <$> getArgs + forM_ [1..n] $ \n' -> + when (sum [1.. m::Integer] > 0) $ setNumCapabilities (fromIntegral n') diff --git a/testsuite/tests/rts/stack004.hs b/testsuite/tests/rts/stack004.hs new file mode 100644 index 0000000000..4c9e337bbf --- /dev/null +++ b/testsuite/tests/rts/stack004.hs @@ -0,0 +1,10 @@ +module Main where + +import Control.Monad +import GHC.RTS.Flags + +-- Ensure that +RTS -K0 is parsed +main :: IO () +main = do + flags <- getGCFlags + unless (maxStkSize flags == 0) $ putStrLn "uh oh" diff --git a/testsuite/tests/rts/traceBinaryEvent.hs b/testsuite/tests/rts/traceBinaryEvent.hs new file mode 100644 index 0000000000..c174d44bc2 --- /dev/null +++ b/testsuite/tests/rts/traceBinaryEvent.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +import Data.Word +import GHC.Base +import GHC.Ptr + +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as BU + +main :: IO () +main = do + traceBinaryEventIO "0123456789" + traceBinaryEventIO $ B.replicate 10 0 + traceBinaryEventIO $ B.replicate (maxSize + 1) 0 + +maxSize :: Int +maxSize = fromIntegral (maxBound :: Word16) + +traceBinaryEventIO :: B.ByteString -> IO () +traceBinaryEventIO bytes = + BU.unsafeUseAsCStringLen bytes $ \(Ptr p, I# n) -> IO $ \s -> do + case traceBinaryEvent# p n s of + s' -> (# s', () #) diff --git a/testsuite/tests/rts/traceBinaryEvent.stderr b/testsuite/tests/rts/traceBinaryEvent.stderr new file mode 100644 index 0000000000..354e919e2a --- /dev/null +++ b/testsuite/tests/rts/traceBinaryEvent.stderr @@ -0,0 +1 @@ +traceBinaryEvent: Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out diff --git a/testsuite/tests/rts/traceEvent.hs b/testsuite/tests/rts/traceEvent.hs index a5e19a995c..06a2b19584 100644 --- a/testsuite/tests/rts/traceEvent.hs +++ b/testsuite/tests/rts/traceEvent.hs @@ -1,5 +1,10 @@ +import Data.Word import Debug.Trace main = do traceEventIO "testing" traceEventIO "%s" -- see #3874 + traceEventIO $ replicate (maxSize + 1) 'A' + +maxSize :: Int +maxSize = fromIntegral (maxBound :: Word16) diff --git a/testsuite/tests/rts/traceEvent.stderr b/testsuite/tests/rts/traceEvent.stderr new file mode 100644 index 0000000000..6a62dc79e2 --- /dev/null +++ b/testsuite/tests/rts/traceEvent.stderr @@ -0,0 +1 @@ +traceEvent: Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out |