summaryrefslogtreecommitdiff
path: root/testsuite/tests/rts
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/rts')
-rw-r--r--testsuite/tests/rts/2047.hs102
-rw-r--r--testsuite/tests/rts/2783.hs1
-rw-r--r--testsuite/tests/rts/2783.stderr1
-rw-r--r--testsuite/tests/rts/3236.c7
-rw-r--r--testsuite/tests/rts/3236.stderr1
-rw-r--r--testsuite/tests/rts/3424.hs611
-rw-r--r--testsuite/tests/rts/3424.stdout1
-rw-r--r--testsuite/tests/rts/4059.hs22
-rw-r--r--testsuite/tests/rts/4059_c.c4
-rw-r--r--testsuite/tests/rts/4850.hs31
-rw-r--r--testsuite/tests/rts/4850.stdout1
-rw-r--r--testsuite/tests/rts/5250.hs60
-rw-r--r--testsuite/tests/rts/Makefile38
-rw-r--r--testsuite/tests/rts/T2615.hs9
-rw-r--r--testsuite/tests/rts/T2615.stdout1
-rw-r--r--testsuite/tests/rts/T4059.stdout2
-rw-r--r--testsuite/tests/rts/all.T117
-rw-r--r--testsuite/tests/rts/atomicinc.c21
-rw-r--r--testsuite/tests/rts/bug1010.hs16
-rw-r--r--testsuite/tests/rts/bug1010.stdout1
-rw-r--r--testsuite/tests/rts/derefnull.hs14
-rw-r--r--testsuite/tests/rts/derefnull.stderr-x86_64-unknown-openbsd1
-rw-r--r--testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw321
-rw-r--r--testsuite/tests/rts/divbyzero.hs13
-rw-r--r--testsuite/tests/rts/divbyzero.stderr-x86_64-unknown-openbsd1
-rw-r--r--testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw321
-rw-r--r--testsuite/tests/rts/exec_signals.hs20
-rw-r--r--testsuite/tests/rts/exec_signals_child.c47
-rw-r--r--testsuite/tests/rts/exec_signals_prepare.c29
-rw-r--r--testsuite/tests/rts/libfoo_T2615.c2
-rw-r--r--testsuite/tests/rts/libfoo_script_T2615.so5
-rw-r--r--testsuite/tests/rts/outofmem.hs7
-rw-r--r--testsuite/tests/rts/outofmem.stderr1
-rw-r--r--testsuite/tests/rts/outofmem.stderr-i386-apple-darwin1
-rw-r--r--testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw321
-rw-r--r--testsuite/tests/rts/outofmem.stderr-powerpc-apple-darwin1
-rw-r--r--testsuite/tests/rts/outofmem.stderr-ws-321
-rw-r--r--testsuite/tests/rts/outofmem.stderr-ws-641
-rw-r--r--testsuite/tests/rts/outofmem.stdout1
-rw-r--r--testsuite/tests/rts/outofmem2.hs10
-rw-r--r--testsuite/tests/rts/outofmem2.stderr3
-rw-r--r--testsuite/tests/rts/outofmem2.stdout1
-rw-r--r--testsuite/tests/rts/return_mem_to_os.hs21
-rw-r--r--testsuite/tests/rts/return_mem_to_os.stdout21
-rw-r--r--testsuite/tests/rts/rtsflags001.hs1
-rw-r--r--testsuite/tests/rts/rtsflags001.stderr-ws-321
-rw-r--r--testsuite/tests/rts/rtsflags001.stderr-ws-641
-rw-r--r--testsuite/tests/rts/spalign.c30
-rw-r--r--testsuite/tests/rts/stack001.hs9
-rw-r--r--testsuite/tests/rts/stack002.hs2
-rw-r--r--testsuite/tests/rts/stack003.hs17
-rw-r--r--testsuite/tests/rts/stack003.stdout1
-rw-r--r--testsuite/tests/rts/testblockalloc.c75
-rw-r--r--testsuite/tests/rts/testheapalloced.c100
-rw-r--r--testsuite/tests/rts/testwsdeque.c167
-rw-r--r--testsuite/tests/rts/traceEvent.hs5
56 files changed, 1660 insertions, 0 deletions
diff --git a/testsuite/tests/rts/2047.hs b/testsuite/tests/rts/2047.hs
new file mode 100644
index 0000000000..08b72664a9
--- /dev/null
+++ b/testsuite/tests/rts/2047.hs
@@ -0,0 +1,102 @@
+module Main where
+
+import qualified Data.Set as Set
+import Control.Monad
+import Data.List
+
+---
+---
+---
+
+data Direction = DirUp | DirLeft | DirRight | DirDown
+ deriving (Eq,Ord,Show,Read)
+
+directions = [DirUp,DirLeft,DirRight,DirDown]
+
+coordOffset DirUp = (-1,0)
+coordOffset DirLeft = (0,-1)
+coordOffset DirRight = (0,1)
+coordOffset DirDown = (1,0)
+
+move (r,c) d = (r+dr,c+dc) where (dr,dc) = coordOffset d
+
+sortPair (x,y) =
+ case compare x y of
+ EQ -> (x,y)
+ LT -> (x,y)
+ GT -> (y,x)
+mapPair12 f (x,y) = (f x,f y)
+
+cachedUsingList f = f'
+ where
+ list = map f [0..]
+ f' i = list !! i
+
+nubSorted [] = []
+nubSorted (x:xs) = nubSorted' x xs
+ where
+ nubSorted' x [] = [x]
+ nubSorted' x (y:ys)
+ | x == y = nubSorted' x ys
+ | otherwise = x : nubSorted' y ys
+
+---
+---
+---
+
+size = 21
+largestExplicitlyEnumeratedArea = 7
+
+type Cell = (Int,Int)
+type Edge = (Cell,Cell)
+
+mkEdge cell1 cell2 = sortPair (cell1,cell2)
+
+cellsAround area = nubSorted $ sort $
+ do
+ cell <- area
+ dir <- directions
+ let cell2 = move cell dir
+ guard $ cell2 `notElem` area
+ return $ cell2
+
+increaseAreas areas = nubSorted $ sort $
+ do
+ area <- areas
+ cell2 <- cellsAround area
+ return $ sort $ cell2 : area
+getAreas :: Int -> [[Cell]]
+getAreasRaw 1 = [[(0,0)]]
+getAreasRaw n = areas
+ where
+ areas = increaseAreas $ getAreas $ n - 1
+getAreas = cachedUsingList getAreasRaw
+
+getEdges area = mapPair12 (map snd) $ partition fst $ nubSorted $ sort $
+ do
+ cell <- area
+ dir <- directions
+ let cell2 = move cell dir
+ let isInternal = cell2 `elem` area
+ return (isInternal,mkEdge cell cell2)
+
+type SizedArea = (Int,((Set.Set Cell,Set.Set Cell),(Set.Set Edge,Set.Set Edge)))
+getExtendedAreas n =
+ do
+ area <- getAreas n
+ let areaAround = cellsAround area
+ let edgeInfo = getEdges area
+ return ((Set.fromList area,Set.fromList areaAround),mapPair12 Set.fromList edgeInfo)
+
+getSizedAreasThrough :: Int -> [SizedArea]
+getSizedAreasThrough n =
+ do
+ n' <- [1 .. n]
+ extendedArea <- getExtendedAreas n'
+ return $ (n',extendedArea)
+
+sizeForSizedArea (asize,_) = asize
+allSizedAreas = getSizedAreasThrough largestExplicitlyEnumeratedArea
+
+main = print $ allSizedAreas
+
diff --git a/testsuite/tests/rts/2783.hs b/testsuite/tests/rts/2783.hs
new file mode 100644
index 0000000000..5edca4e7cd
--- /dev/null
+++ b/testsuite/tests/rts/2783.hs
@@ -0,0 +1 @@
+main = print $ do x <- [ 0 .. 5 ] ; let { y = 5 - y } ; return y
diff --git a/testsuite/tests/rts/2783.stderr b/testsuite/tests/rts/2783.stderr
new file mode 100644
index 0000000000..86d45f2a1a
--- /dev/null
+++ b/testsuite/tests/rts/2783.stderr
@@ -0,0 +1 @@
+2783: <<loop>>
diff --git a/testsuite/tests/rts/3236.c b/testsuite/tests/rts/3236.c
new file mode 100644
index 0000000000..92d4c12dcd
--- /dev/null
+++ b/testsuite/tests/rts/3236.c
@@ -0,0 +1,7 @@
+#include "Rts.h"
+
+int main (int argc, char *argv[])
+{
+ // should fail: RTS is not initialised
+ rts_lock();
+}
diff --git a/testsuite/tests/rts/3236.stderr b/testsuite/tests/rts/3236.stderr
new file mode 100644
index 0000000000..c1f0511021
--- /dev/null
+++ b/testsuite/tests/rts/3236.stderr
@@ -0,0 +1 @@
+newBoundTask: RTS is not initialised; call hs_init() first
diff --git a/testsuite/tests/rts/3424.hs b/testsuite/tests/rts/3424.hs
new file mode 100644
index 0000000000..e168df49c0
--- /dev/null
+++ b/testsuite/tests/rts/3424.hs
@@ -0,0 +1,611 @@
+
+module Main (main) where
+
+import Control.Monad (guard)
+
+main :: IO ()
+main = print $ head z
+
+z :: [[Int]]
+z = do x1 <- [0..3]
+ x2 <- [0..3]
+ x3 <- [0..3]
+ x4 <- [0..3]
+ x5 <- [0..3]
+ x6 <- [0..3]
+ x7 <- [0..3]
+ x8 <- [0..3]
+ x9 <- [0..3]
+ x10 <- [0..3]
+ x11 <- [0..3]
+ x12 <- [0..3]
+ x13 <- [0..3]
+ x14 <- [0..3]
+ x15 <- [0..3]
+ x16 <- [0..3]
+ x17 <- [0..3]
+ x18 <- [0..3]
+ x19 <- [0..3]
+ x20 <- [0..3]
+ x21 <- [0..3]
+ x22 <- [0..3]
+ x23 <- [0..3]
+ x24 <- [0..3]
+ x25 <- [0..3]
+ x26 <- [0..3]
+ x27 <- [0..3]
+ x28 <- [0..3]
+ x29 <- [0..3]
+ x30 <- [0..3]
+ x31 <- [0..3]
+ x32 <- [0..3]
+ x33 <- [0..3]
+ x34 <- [0..3]
+ x35 <- [0..3]
+ x36 <- [0..3]
+ x37 <- [0..3]
+ x38 <- [0..3]
+ x39 <- [0..3]
+ x40 <- [0..3]
+ x41 <- [0..3]
+ x42 <- [0..3]
+ x43 <- [0..3]
+ x44 <- [0..3]
+ x45 <- [0..3]
+ x46 <- [0..3]
+ x47 <- [0..3]
+ x48 <- [0..3]
+ x49 <- [0..3]
+ x50 <- [0..3]
+ x51 <- [0..3]
+ x52 <- [0..3]
+ x53 <- [0..3]
+ x54 <- [0..3]
+ x55 <- [0..3]
+ x56 <- [0..3]
+ x57 <- [0..3]
+ x58 <- [0..3]
+ x59 <- [0..3]
+ x60 <- [0..3]
+ x61 <- [0..3]
+ x62 <- [0..3]
+ x63 <- [0..3]
+ x64 <- [0..3]
+ x65 <- [0..3]
+ x66 <- [0..3]
+ x67 <- [0..3]
+ x68 <- [0..3]
+ x69 <- [0..3]
+ x70 <- [0..3]
+ x71 <- [0..3]
+ x72 <- [0..3]
+ x73 <- [0..3]
+ x74 <- [0..3]
+ x75 <- [0..3]
+ x76 <- [0..3]
+ x77 <- [0..3]
+ x78 <- [0..3]
+ x79 <- [0..3]
+ x80 <- [0..3]
+ x81 <- [0..3]
+ x82 <- [0..3]
+ x83 <- [0..3]
+ x84 <- [0..3]
+ x85 <- [0..3]
+ x86 <- [0..3]
+ x87 <- [0..3]
+ x88 <- [0..3]
+ x89 <- [0..3]
+ x90 <- [0..3]
+ x91 <- [0..3]
+ x92 <- [0..3]
+ x93 <- [0..3]
+ x94 <- [0..3]
+ x95 <- [0..3]
+ x96 <- [0..3]
+ x97 <- [0..3]
+ x98 <- [0..3]
+ x99 <- [0..3]
+ x100 <- [0..3]
+ x101 <- [0..3]
+ x102 <- [0..3]
+ x103 <- [0..3]
+ x104 <- [0..3]
+ x105 <- [0..3]
+ x106 <- [0..3]
+ x107 <- [0..3]
+ x108 <- [0..3]
+ x109 <- [0..3]
+ x110 <- [0..3]
+ x111 <- [0..3]
+ x112 <- [0..3]
+ x113 <- [0..3]
+ x114 <- [0..3]
+ x115 <- [0..3]
+ x116 <- [0..3]
+ x117 <- [0..3]
+ x118 <- [0..3]
+ x119 <- [0..3]
+ x120 <- [0..3]
+ x121 <- [0..3]
+ x122 <- [0..3]
+ x123 <- [0..3]
+ x124 <- [0..3]
+ x125 <- [0..3]
+ x126 <- [0..3]
+ x127 <- [0..3]
+ x128 <- [0..3]
+ x129 <- [0..3]
+ x130 <- [0..3]
+ x131 <- [0..3]
+ x132 <- [0..3]
+ x133 <- [0..3]
+ x134 <- [0..3]
+ x135 <- [0..3]
+ x136 <- [0..3]
+ x137 <- [0..3]
+ x138 <- [0..3]
+ x139 <- [0..3]
+ x140 <- [0..3]
+ x141 <- [0..3]
+ x142 <- [0..3]
+ x143 <- [0..3]
+ x144 <- [0..3]
+ x145 <- [0..3]
+ x146 <- [0..3]
+ x147 <- [0..3]
+ x148 <- [0..3]
+ x149 <- [0..3]
+ x150 <- [0..3]
+ x151 <- [0..3]
+ x152 <- [0..3]
+ x153 <- [0..3]
+ x154 <- [0..3]
+ x155 <- [0..3]
+ x156 <- [0..3]
+ x157 <- [0..3]
+ x158 <- [0..3]
+ x159 <- [0..3]
+ x160 <- [0..3]
+ x161 <- [0..3]
+ x162 <- [0..3]
+ x163 <- [0..3]
+ x164 <- [0..3]
+ x165 <- [0..3]
+ x166 <- [0..3]
+ x167 <- [0..3]
+ x168 <- [0..3]
+ x169 <- [0..3]
+ x170 <- [0..3]
+ x171 <- [0..3]
+ x172 <- [0..3]
+ x173 <- [0..3]
+ x174 <- [0..3]
+ x175 <- [0..3]
+ x176 <- [0..3]
+ x177 <- [0..3]
+ x178 <- [0..3]
+ x179 <- [0..3]
+ x180 <- [0..3]
+ x181 <- [0..3]
+ x182 <- [0..3]
+ x183 <- [0..3]
+ x184 <- [0..3]
+ x185 <- [0..3]
+ x186 <- [0..3]
+ x187 <- [0..3]
+ x188 <- [0..3]
+ x189 <- [0..3]
+ x190 <- [0..3]
+ x191 <- [0..3]
+ x192 <- [0..3]
+ x193 <- [0..3]
+ x194 <- [0..3]
+ x195 <- [0..3]
+ x196 <- [0..3]
+ x197 <- [0..3]
+ x198 <- [0..3]
+ x199 <- [0..3]
+ x200 <- [0..3]
+ x201 <- [0..3]
+ x202 <- [0..3]
+ x203 <- [0..3]
+ x204 <- [0..3]
+ x205 <- [0..3]
+ x206 <- [0..3]
+ x207 <- [0..3]
+ x208 <- [0..3]
+ x209 <- [0..3]
+ x210 <- [0..3]
+ x211 <- [0..3]
+ x212 <- [0..3]
+ x213 <- [0..3]
+ x214 <- [0..3]
+ x215 <- [0..3]
+ x216 <- [0..3]
+ x217 <- [0..3]
+ x218 <- [0..3]
+ x219 <- [0..3]
+ x220 <- [0..3]
+ x221 <- [0..3]
+ x222 <- [0..3]
+ x223 <- [0..3]
+ x224 <- [0..3]
+ x225 <- [0..3]
+ x226 <- [0..3]
+ x227 <- [0..3]
+ x228 <- [0..3]
+ x229 <- [0..3]
+ x230 <- [0..3]
+ x231 <- [0..3]
+ x232 <- [0..3]
+ x233 <- [0..3]
+ x234 <- [0..3]
+ x235 <- [0..3]
+ x236 <- [0..3]
+ x237 <- [0..3]
+ x238 <- [0..3]
+ x239 <- [0..3]
+ x240 <- [0..3]
+ x241 <- [0..3]
+ x242 <- [0..3]
+ x243 <- [0..3]
+ x244 <- [0..3]
+ x245 <- [0..3]
+ x246 <- [0..3]
+ x247 <- [0..3]
+ x248 <- [0..3]
+ x249 <- [0..3]
+ x250 <- [0..3]
+ x251 <- [0..3]
+ x252 <- [0..3]
+ x253 <- [0..3]
+ x254 <- [0..3]
+ x255 <- [0..3]
+ x256 <- [0..3]
+ x257 <- [0..3]
+ x258 <- [0..3]
+ x259 <- [0..3]
+ x260 <- [0..3]
+ x261 <- [0..3]
+ x262 <- [0..3]
+ x263 <- [0..3]
+ x264 <- [0..3]
+ x265 <- [0..3]
+ x266 <- [0..3]
+ x267 <- [0..3]
+ x268 <- [0..3]
+ x269 <- [0..3]
+ x270 <- [0..3]
+ x271 <- [0..3]
+ x272 <- [0..3]
+ x273 <- [0..3]
+ x274 <- [0..3]
+ x275 <- [0..3]
+ x276 <- [0..3]
+ x277 <- [0..3]
+ x278 <- [0..3]
+ x279 <- [0..3]
+ x280 <- [0..3]
+ x281 <- [0..3]
+ x282 <- [0..3]
+ x283 <- [0..3]
+ x284 <- [0..3]
+ x285 <- [0..3]
+ x286 <- [0..3]
+ x287 <- [0..3]
+ x288 <- [0..3]
+ x289 <- [0..3]
+ x290 <- [0..3]
+ x291 <- [0..3]
+ x292 <- [0..3]
+ x293 <- [0..3]
+ x294 <- [0..3]
+ x295 <- [0..3]
+ x296 <- [0..3]
+ x297 <- [0..3]
+ x298 <- [0..3]
+ x299 <- [0..3]
+ x300 <- [0..3]
+ x301 <- [0..3]
+ x302 <- [0..3]
+ x303 <- [0..3]
+ x304 <- [0..3]
+ x305 <- [0..3]
+ x306 <- [0..3]
+ x307 <- [0..3]
+ x308 <- [0..3]
+ x309 <- [0..3]
+ x310 <- [0..3]
+ x311 <- [0..3]
+ x312 <- [0..3]
+ x313 <- [0..3]
+ x314 <- [0..3]
+ x315 <- [0..3]
+ x316 <- [0..3]
+ x317 <- [0..3]
+ x318 <- [0..3]
+ x319 <- [0..3]
+ x320 <- [0..3]
+ x321 <- [0..3]
+ x322 <- [0..3]
+ x323 <- [0..3]
+ x324 <- [0..3]
+ x325 <- [0..3]
+ x326 <- [0..3]
+ x327 <- [0..3]
+ x328 <- [0..3]
+ x329 <- [0..3]
+ x330 <- [0..3]
+ x331 <- [0..3]
+ x332 <- [0..3]
+ x333 <- [0..3]
+ x334 <- [0..3]
+ x335 <- [0..3]
+ x336 <- [0..3]
+ x337 <- [0..3]
+ x338 <- [0..3]
+ x339 <- [0..3]
+ x340 <- [0..3]
+ x341 <- [0..3]
+ x342 <- [0..3]
+ x343 <- [0..3]
+ x344 <- [0..3]
+ x345 <- [0..3]
+ x346 <- [0..3]
+ x347 <- [0..3]
+ x348 <- [0..3]
+ x349 <- [0..3]
+ x350 <- [0..3]
+ x351 <- [0..3]
+ x352 <- [0..3]
+ x353 <- [0..3]
+ x354 <- [0..3]
+ x355 <- [0..3]
+ x356 <- [0..3]
+ x357 <- [0..3]
+ x358 <- [0..3]
+ x359 <- [0..3]
+ x360 <- [0..3]
+ x361 <- [0..3]
+ x362 <- [0..3]
+ x363 <- [0..3]
+ x364 <- [0..3]
+ x365 <- [0..3]
+ x366 <- [0..3]
+ x367 <- [0..3]
+ x368 <- [0..3]
+ x369 <- [0..3]
+ x370 <- [0..3]
+ x371 <- [0..3]
+ x372 <- [0..3]
+ x373 <- [0..3]
+ x374 <- [0..3]
+ x375 <- [0..3]
+ x376 <- [0..3]
+ x377 <- [0..3]
+ x378 <- [0..3]
+ x379 <- [0..3]
+ x380 <- [0..3]
+ x381 <- [0..3]
+ x382 <- [0..3]
+ x383 <- [0..3]
+ x384 <- [0..3]
+ x385 <- [0..3]
+ x386 <- [0..3]
+ x387 <- [0..3]
+ x388 <- [0..3]
+ x389 <- [0..3]
+ x390 <- [0..3]
+ x391 <- [0..3]
+ x392 <- [0..3]
+ x393 <- [0..3]
+ x394 <- [0..3]
+ x395 <- [0..3]
+ x396 <- [0..3]
+ x397 <- [0..3]
+ x398 <- [0..3]
+ x399 <- [0..3]
+ x400 <- [0..3]
+ x401 <- [0..3]
+ x402 <- [0..3]
+ x403 <- [0..3]
+ x404 <- [0..3]
+ x405 <- [0..3]
+ x406 <- [0..3]
+ x407 <- [0..3]
+ x408 <- [0..3]
+ x409 <- [0..3]
+ x410 <- [0..3]
+ x411 <- [0..3]
+ x412 <- [0..3]
+ x413 <- [0..3]
+ x414 <- [0..3]
+ x415 <- [0..3]
+ x416 <- [0..3]
+ x417 <- [0..3]
+ x418 <- [0..3]
+ x419 <- [0..3]
+ x420 <- [0..3]
+ x421 <- [0..3]
+ x422 <- [0..3]
+ x423 <- [0..3]
+ x424 <- [0..3]
+ x425 <- [0..3]
+ x426 <- [0..3]
+ x427 <- [0..3]
+ x428 <- [0..3]
+ x429 <- [0..3]
+ x430 <- [0..3]
+ x431 <- [0..3]
+ x432 <- [0..3]
+ x433 <- [0..3]
+ x434 <- [0..3]
+ x435 <- [0..3]
+ x436 <- [0..3]
+ x437 <- [0..3]
+ x438 <- [0..3]
+ x439 <- [0..3]
+ x440 <- [0..3]
+ x441 <- [0..3]
+ x442 <- [0..3]
+ x443 <- [0..3]
+ x444 <- [0..3]
+ x445 <- [0..3]
+ x446 <- [0..3]
+ x447 <- [0..3]
+ x448 <- [0..3]
+ x449 <- [0..3]
+ x450 <- [0..3]
+ x451 <- [0..3]
+ x452 <- [0..3]
+ x453 <- [0..3]
+ x454 <- [0..3]
+ x455 <- [0..3]
+ x456 <- [0..3]
+ x457 <- [0..3]
+ x458 <- [0..3]
+ x459 <- [0..3]
+ x460 <- [0..3]
+ x461 <- [0..3]
+ x462 <- [0..3]
+ x463 <- [0..3]
+ x464 <- [0..3]
+ x465 <- [0..3]
+ x466 <- [0..3]
+ x467 <- [0..3]
+ x468 <- [0..3]
+ x469 <- [0..3]
+ x470 <- [0..3]
+ x471 <- [0..3]
+ x472 <- [0..3]
+ x473 <- [0..3]
+ x474 <- [0..3]
+ x475 <- [0..3]
+ x476 <- [0..3]
+ x477 <- [0..3]
+ x478 <- [0..3]
+ x479 <- [0..3]
+ x480 <- [0..3]
+ x481 <- [0..3]
+ x482 <- [0..3]
+ x483 <- [0..3]
+ x484 <- [0..3]
+ x485 <- [0..3]
+ x486 <- [0..3]
+ x487 <- [0..3]
+ x488 <- [0..3]
+ x489 <- [0..3]
+ x490 <- [0..3]
+ x491 <- [0..3]
+ x492 <- [0..3]
+ x493 <- [0..3]
+ x494 <- [0..3]
+ x495 <- [0..3]
+ x496 <- [0..3]
+ x497 <- [0..3]
+ x498 <- [0..3]
+ x499 <- [0..3]
+ x500 <- [0..3]
+ x501 <- [0..3]
+ x502 <- [0..3]
+ x503 <- [0..3]
+ x504 <- [0..3]
+ x505 <- [0..3]
+ x506 <- [0..3]
+ x507 <- [0..3]
+ x508 <- [0..3]
+ x509 <- [0..3]
+ x510 <- [0..3]
+ x511 <- [0..3]
+ x512 <- [0..3]
+ x513 <- [0..3]
+ x514 <- [0..3]
+ x515 <- [0..3]
+ x516 <- [0..3]
+ x517 <- [0..3]
+ x518 <- [0..3]
+ x519 <- [0..3]
+ x520 <- [0..3]
+ x521 <- [0..3]
+ x522 <- [0..3]
+ x523 <- [0..3]
+ x524 <- [0..3]
+ x525 <- [0..3]
+ x526 <- [0..3]
+ x527 <- [0..3]
+ x528 <- [0..3]
+ x529 <- [0..3]
+ x530 <- [0..3]
+ x531 <- [0..3]
+ x532 <- [0..3]
+ x533 <- [0..3]
+ x534 <- [0..3]
+ x535 <- [0..3]
+ x536 <- [0..3]
+ x537 <- [0..3]
+ x538 <- [0..3]
+ x539 <- [0..3]
+ x540 <- [0..3]
+ x541 <- [0..3]
+ x542 <- [0..3]
+ x543 <- [0..3]
+ x544 <- [0..3]
+ x545 <- [0..3]
+ x546 <- [0..3]
+ x547 <- [0..3]
+ x548 <- [0..3]
+ x549 <- [0..3]
+ x550 <- [0..3]
+ x551 <- [0..3]
+ x552 <- [0..3]
+ x553 <- [0..3]
+ x554 <- [0..3]
+ x555 <- [0..3]
+ x556 <- [0..3]
+ x557 <- [0..3]
+ x558 <- [0..3]
+ x559 <- [0..3]
+ x560 <- [0..3]
+ x561 <- [0..3]
+ x562 <- [0..3]
+ x563 <- [0..3]
+ x564 <- [0..3]
+ x565 <- [0..3]
+ x566 <- [0..3]
+ x567 <- [0..3]
+ x568 <- [0..3]
+ x569 <- [0..3]
+ x570 <- [0..3]
+ x571 <- [0..3]
+ x572 <- [0..3]
+ x573 <- [0..3]
+ x574 <- [0..3]
+ x575 <- [0..3]
+ x576 <- [0..3]
+ x577 <- [0..3]
+ x578 <- [0..3]
+ x579 <- [0..3]
+ x580 <- [0..3]
+ x581 <- [0..3]
+ x582 <- [0..3]
+ x583 <- [0..3]
+ x584 <- [0..3]
+ x585 <- [0..3]
+ x586 <- [0..3]
+ x587 <- [0..3]
+ x588 <- [0..3]
+ x589 <- [0..3]
+ x590 <- [0..3]
+ x591 <- [0..3]
+ x592 <- [0..3]
+ x593 <- [0..3]
+ x594 <- [0..3]
+ x595 <- [0..3]
+ x596 <- [0..3]
+ x597 <- [0..3]
+ x598 <- [0..3]
+ x599 <- [0..3]
+ x600 <- [0..3]
+ guard (x1+x2+2*x3 >= 0)
+ return [x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,x21,x22,x23,x24,x25,x26,x27,x28,x29,x30,x31,x32,x33,x34,x35,x36,x37,x38,x39,x40,x41,x42,x43,x44,x45,x46,x47,x48,x49,x50,x51,x52,x53,x54,x55,x56,x57,x58,x59,x60,x61,x62,x63,x64,x65,x66,x67,x68,x69,x70,x71,x72,x73,x74,x75,x76,x77,x78,x79,x80,x81,x82,x83,x84,x85,x86,x87,x88,x89,x90,x91,x92,x93,x94,x95,x96,x97,x98,x99,x100,x101,x102,x103,x104,x105,x106,x107,x108,x109,x110,x111,x112,x113,x114,x115,x116,x117,x118,x119,x120,x121,x122,x123,x124,x125,x126,x127,x128,x129,x130,x131,x132,x133,x134,x135,x136,x137,x138,x139,x140,x141,x142,x143,x144,x145,x146,x147,x148,x149,x150,x151,x152,x153,x154,x155,x156,x157,x158,x159,x160,x161,x162,x163,x164,x165,x166,x167,x168,x169,x170,x171,x172,x173,x174,x175,x176,x177,x178,x179,x180,x181,x182,x183,x184,x185,x186,x187,x188,x189,x190,x191,x192,x193,x194,x195,x196,x197,x198,x199,x200,x201,x202,x203,x204,x205,x206,x207,x208,x209,x210,x211,x212,x213,x214,x215,x216,x217,x218,x219,x220,x221,x222,x223,x224,x225,x226,x227,x228,x229,x230,x231,x232,x233,x234,x235,x236,x237,x238,x239,x240,x241,x242,x243,x244,x245,x246,x247,x248,x249,x250,x251,x252,x253,x254,x255,x256,x257,x258,x259,x260,x261,x262,x263,x264,x265,x266,x267,x268,x269,x270,x271,x272,x273,x274,x275,x276,x277,x278,x279,x280,x281,x282,x283,x284,x285,x286,x287,x288,x289,x290,x291,x292,x293,x294,x295,x296,x297,x298,x299,x300,x301,x302,x303,x304,x305,x306,x307,x308,x309,x310,x311,x312,x313,x314,x315,x316,x317,x318,x319,x320,x321,x322,x323,x324,x325,x326,x327,x328,x329,x330,x331,x332,x333,x334,x335,x336,x337,x338,x339,x340,x341,x342,x343,x344,x345,x346,x347,x348,x349,x350,x351,x352,x353,x354,x355,x356,x357,x358,x359,x360,x361,x362,x363,x364,x365,x366,x367,x368,x369,x370,x371,x372,x373,x374,x375,x376,x377,x378,x379,x380,x381,x382,x383,x384,x385,x386,x387,x388,x389,x390,x391,x392,x393,x394,x395,x396,x397,x398,x399,x400,x401,x402,x403,x404,x405,x406,x407,x408,x409,x410,x411,x412,x413,x414,x415,x416,x417,x418,x419,x420,x421,x422,x423,x424,x425,x426,x427,x428,x429,x430,x431,x432,x433,x434,x435,x436,x437,x438,x439,x440,x441,x442,x443,x444,x445,x446,x447,x448,x449,x450,x451,x452,x453,x454,x455,x456,x457,x458,x459,x460,x461,x462,x463,x464,x465,x466,x467,x468,x469,x470,x471,x472,x473,x474,x475,x476,x477,x478,x479,x480,x481,x482,x483,x484,x485,x486,x487,x488,x489,x490,x491,x492,x493,x494,x495,x496,x497,x498,x499,x500,x501,x502,x503,x504,x505,x506,x507,x508,x509,x510,x511,x512,x513,x514,x515,x516,x517,x518,x519,x520,x521,x522,x523,x524,x525,x526,x527,x528,x529,x530,x531,x532,x533,x534,x535,x536,x537,x538,x539,x540,x541,x542,x543,x544,x545,x546,x547,x548,x549,x550,x551,x552,x553,x554,x555,x556,x557,x558,x559,x560,x561,x562,x563,x564,x565,x566,x567,x568,x569,x570,x571,x572,x573,x574,x575,x576,x577,x578,x579,x580,x581,x582,x583,x584,x585,x586,x587,x588,x589,x590,x591,x592,x593,x594,x595,x596,x597,x598,x599,x600]
diff --git a/testsuite/tests/rts/3424.stdout b/testsuite/tests/rts/3424.stdout
new file mode 100644
index 0000000000..e905960197
--- /dev/null
+++ b/testsuite/tests/rts/3424.stdout
@@ -0,0 +1 @@
+[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
diff --git a/testsuite/tests/rts/4059.hs b/testsuite/tests/rts/4059.hs
new file mode 100644
index 0000000000..5af5bbc4aa
--- /dev/null
+++ b/testsuite/tests/rts/4059.hs
@@ -0,0 +1,22 @@
+
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+import Foreign hiding ( unsafePerformIO )
+import Foreign.C
+import System.IO.Unsafe
+
+d f x = unsafePerformIO $ do
+ g <- mkfun f
+ r <- deriv g x 1
+ return r
+
+main = do
+ print $ d (\x -> x * 2) 3
+ print $ d (\x -> x * d (\y -> x + y) 5) 7
+
+
+foreign import ccall safe "deriv"
+ deriv :: FunPtr (CDouble -> CDouble) -> CDouble -> CDouble -> IO CDouble
+
+foreign import ccall safe "wrapper"
+ mkfun :: (CDouble -> CDouble) -> IO (FunPtr (CDouble -> CDouble))
diff --git a/testsuite/tests/rts/4059_c.c b/testsuite/tests/rts/4059_c.c
new file mode 100644
index 0000000000..3595b82cae
--- /dev/null
+++ b/testsuite/tests/rts/4059_c.c
@@ -0,0 +1,4 @@
+
+double deriv(double f(double), double x, double h) {
+ return f(x) + h;
+}
diff --git a/testsuite/tests/rts/4850.hs b/testsuite/tests/rts/4850.hs
new file mode 100644
index 0000000000..72616d97eb
--- /dev/null
+++ b/testsuite/tests/rts/4850.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Main where
+
+import Foreign
+import Control.Concurrent
+
+type Fun = Int -> IO Int
+
+foreign import ccall "wrapper" mkF :: Fun -> IO (FunPtr Fun)
+
+foreign import ccall "dynamic" callF :: FunPtr Fun -> Fun
+
+-- This test should create 4 OS threads only:
+-- one for main
+-- worker 1 for the IO manager
+-- worker 2 to run the first forkIO
+-- worker 3 created when worker 2 makes its foreign call
+
+-- Due to #4850, an extra worker was being created because worker 2 was
+-- lost after returning from its foreign call.
+
+main = do
+ m <- newEmptyMVar
+ callback m >> takeMVar m >>= print
+ callback m >> takeMVar m >>= print
+
+callback m =
+ forkIO $ do
+ f <- mkF $ \x -> return (x+1)
+ r <- callF f 3
+ putMVar m r
diff --git a/testsuite/tests/rts/4850.stdout b/testsuite/tests/rts/4850.stdout
new file mode 100644
index 0000000000..b8626c4cff
--- /dev/null
+++ b/testsuite/tests/rts/4850.stdout
@@ -0,0 +1 @@
+4
diff --git a/testsuite/tests/rts/5250.hs b/testsuite/tests/rts/5250.hs
new file mode 100644
index 0000000000..f10c2e7c47
--- /dev/null
+++ b/testsuite/tests/rts/5250.hs
@@ -0,0 +1,60 @@
+module Main where
+
+import Foreign
+import Foreign.C
+import Text.Printf
+import System.Exit
+import Control.Monad
+
+foreign import ccall "getesp" getesp :: IO CInt
+
+main = do
+ checkSpAlignment
+ wrap checkSpAlignment >>= run
+ wrap1 args1 >>= \f -> run1 f 3
+ wrap2 args2 >>= \f -> run2 f 3 4
+ wrap3 args3 >>= \f -> run3 f 3 4 5
+ wrap4 args4 >>= \f -> run4 f 3 4 5 6
+
+foreign import ccall "wrapper" wrap :: IO () -> IO (FunPtr (IO ()))
+foreign import ccall "dynamic" run :: FunPtr (IO ()) -> IO ()
+
+type Args1 = Int -> IO ()
+
+foreign import ccall "wrapper" wrap1 :: Args1 -> IO (FunPtr Args1)
+foreign import ccall "dynamic" run1 :: FunPtr Args1 -> Args1
+
+args1 :: Args1
+args1 _ = checkSpAlignment
+
+type Args2 = Int -> Int -> IO ()
+
+foreign import ccall "wrapper" wrap2 :: Args2 -> IO (FunPtr Args2)
+foreign import ccall "dynamic" run2 :: FunPtr Args2 -> Args2
+
+args2 :: Args2
+args2 _ _ = checkSpAlignment
+
+type Args3 = Int -> Int -> Int -> IO ()
+
+foreign import ccall "wrapper" wrap3 :: Args3 -> IO (FunPtr Args3)
+foreign import ccall "dynamic" run3 :: FunPtr Args3 -> Args3
+
+args3 :: Args3
+args3 _ _ _ = checkSpAlignment
+
+type Args4 = Int -> Int -> Int -> Int -> IO ()
+
+foreign import ccall "wrapper" wrap4 :: Args4 -> IO (FunPtr Args4)
+foreign import ccall "dynamic" run4 :: FunPtr Args4 -> Args4
+
+args4 :: Args4
+args4 _ _ _ _ = checkSpAlignment
+
+checkSpAlignment :: IO ()
+checkSpAlignment = do
+ esp <- getesp
+ when (((esp + fromIntegral (sizeOf (undefined :: Ptr ()))) .&. 15) /= 0) $ do
+ printf "esp not aligned correctly: %x\n" (fromIntegral esp :: Word32)
+ exitWith (ExitFailure 1)
+
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
new file mode 100644
index 0000000000..4a65b487fa
--- /dev/null
+++ b/testsuite/tests/rts/Makefile
@@ -0,0 +1,38 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+outofmem-prep::
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make -fforce-recomp outofmem.hs -o outofmem
+
+outofmem::
+ @$(MAKE) outofmem-prep >prep.out 2>prep.out
+ @ulimit -v 10000000 2>/dev/null; ./outofmem || echo "exit($$?)"
+
+outofmem2-prep::
+ '$(TEST_HC)' $(TEST_HC_OPTS) -rtsopts --make -fforce-recomp outofmem2.hs -o outofmem2
+
+outofmem2::
+ @$(MAKE) outofmem2-prep >prep.out 2>prep.out
+ @ulimit -v 1000000 2>/dev/null; ./outofmem2 +RTS -M5m -RTS || echo "exit($$?)"
+
+T2615-prep:
+ $(RM) libfoo_T2615.so
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fPIC -c libfoo_T2615.c -o libfoo_T2615.o
+ '$(TEST_HC)' $(TEST_HC_OPTS) -shared -no-auto-link-packages libfoo_T2615.o -o libfoo_T2615.so
+
+.PHONY: T4059
+T4059:
+ $(RM) 4059_c.o 4059.o 4059.hi
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make 4059 4059_c.c
+ ./4059
+
+exec_signals-prep:
+ $(CC) -o exec_signals_child exec_signals_child.c
+ $(CC) -o exec_signals_prepare exec_signals_prepare.c
+
+.PHONY: 4850
+4850:
+ $(RM) 4850.o 4850.hi 4850$(exeext)
+ "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -rtsopts -debug -threaded --make 4850
+ ./4850 +RTS -s 2>&1 | grep Task | wc -l | tr -d ' '
diff --git a/testsuite/tests/rts/T2615.hs b/testsuite/tests/rts/T2615.hs
new file mode 100644
index 0000000000..ee04d93bcf
--- /dev/null
+++ b/testsuite/tests/rts/T2615.hs
@@ -0,0 +1,9 @@
+import ObjLink
+
+library_name = "libfoo_script_T2615.so" -- this is really a linker script
+
+main = do
+ result <- loadDLL library_name
+ case result of
+ Nothing -> putStrLn (library_name ++ " loaded successfully")
+ Just x -> putStrLn ("error: " ++ x)
diff --git a/testsuite/tests/rts/T2615.stdout b/testsuite/tests/rts/T2615.stdout
new file mode 100644
index 0000000000..16a9ae1c20
--- /dev/null
+++ b/testsuite/tests/rts/T2615.stdout
@@ -0,0 +1 @@
+libfoo_script_T2615.so loaded successfully
diff --git a/testsuite/tests/rts/T4059.stdout b/testsuite/tests/rts/T4059.stdout
new file mode 100644
index 0000000000..34f64643a5
--- /dev/null
+++ b/testsuite/tests/rts/T4059.stdout
@@ -0,0 +1,2 @@
+7.0
+92.0
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
new file mode 100644
index 0000000000..0b37ed19e4
--- /dev/null
+++ b/testsuite/tests/rts/all.T
@@ -0,0 +1,117 @@
+test('testblockalloc', compose(c_src,
+ compose(only_ways(['normal','threaded1']),
+ extra_run_opts('+RTS -I0'))),
+ compile_and_run, [''])
+
+
+# See bug #101, test requires +RTS -c (or equivalently +RTS -M<something>)
+# only GHCi triggers the bug, but we run the test all ways for completeness.
+test('bug1010', normal, compile_and_run, ['+RTS -c -RTS'])
+test('derefnull',
+ composes([
+ # LLVM Optimiser considers dereference of a null pointer
+ # undefined and marks the code as unreachable which means
+ # that later optimisations remove it altogether.
+ omit_ways(['optllvm']),
+ # SIGSEGV on Linux (which we make the default)
+ exit_code(139),
+ # Apparently the output can be different on different
+ # Linux setups, so just ignore it. As long as we get
+ # the right exit code we're OK.
+ if_os('linux', ignore_output),
+ # SIGBUS on OX X (PPC and x86 only; amd64 gives SEGV)
+ if_platform('i386-apple-darwin', exit_code(138)),
+ if_platform('powerpc-apple-darwin', exit_code(138)),
+ if_platform('i386-unknown-mingw32', exit_code(1))]),
+ compile_and_run, [''])
+test('divbyzero',
+ composes([
+ # SIGFPE on Linux
+ exit_code(136),
+ # Apparently the output can be different on different
+ # Linux setups, so just ignore it. As long as we get
+ # the right exit code we're OK.
+ if_os('linux', ignore_output),
+ if_platform('i386-unknown-mingw32', exit_code(1))]),
+ compile_and_run, [''])
+
+test('outofmem', normal, run_command, ['$MAKE -s --no-print-directory outofmem'])
+test('outofmem2', extra_run_opts('+RTS -M5m -RTS'),
+ run_command, ['$MAKE -s --no-print-directory outofmem2'])
+
+test('2047', compose(ignore_output, extra_run_opts('+RTS -c -RTS')),
+ compile_and_run, ['-package containers'])
+
+# Blackhole-detection test.
+# Skip GHCi due to #2786
+test('2783', [ omit_ways(['ghci']), exit_code(1) ], compile_and_run, [''])
+
+# Test the work-stealing deque implementation. We run this test in
+# both threaded1 (-threaded -debug) and threaded2 (-threaded) ways.
+test('testwsdeque', [unless_in_tree_compiler(skip),
+ c_src, only_ways(['threaded1', 'threaded2'])],
+ compile_and_run, ['-I../../../rts'])
+
+test('3236', [c_src, only_ways(['normal','threaded1']), exit_code(1)], compile_and_run, [''])
+
+test('stack001', extra_run_opts('+RTS -K32m -RTS'), compile_and_run, [''])
+test('stack002', extra_run_opts('+RTS -K32m -k4m -RTS'), compile_and_run, [''])
+
+# run this test with very small stack chunks to exercise the stack
+# overflow/underflow machinery.
+test('stack003', [ omit_ways('ghci'), # uses unboxed tuples
+ extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ],
+ compile_and_run, [''])
+
+test('atomicinc', [ c_src, only_ways(['normal']) ], compile_and_run, [''])
+
+test('3424', # it's slow:
+ [ skip_if_fast, only_ways(['normal','threaded1','ghci']) ],
+ compile_and_run, [''])
+
+# Test for out-of-range heap size
+test('rtsflags001', [ only_ways(['normal']), exit_code(1), extra_run_opts('+RTS -H0m -RTS') ], compile_and_run, [''])
+
+# Test to see if linker scripts link properly to real ELF files
+test('T2615',
+ [ if_platform('i386-unknown-mingw32',skip),
+ # OS X doesn't seem to support linker scripts
+ if_os('darwin', skip),
+ # Solaris' linker does not support GNUish linker scripts
+ if_os('solaris2', skip),
+ cmd_prefix('$MAKE T2615-prep && ' +
+ # Add current directory to dlopen search path
+ 'LD_LIBRARY_PATH=$LD_LIBRARY_PATH:. '),
+ extra_clean(['libfoo_T2615.so'])],
+ compile_and_run,
+ ['-package ghc'])
+
+# 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),
+ extra_run_opts('+RTS -ls -RTS') ],
+ compile_and_run, ['-eventlog'])
+
+test('T4059', normal, run_command, ['$MAKE -s --no-print-directory T4059'])
+
+# Test for #4274
+test('exec_signals', [
+ if_platform('i386-unknown-mingw32',skip),
+ cmd_prefix('$MAKE exec_signals-prep && ./exec_signals_prepare'),
+ extra_clean(['exec_signals_child', 'exec_signals_prepare'])
+ ], compile_and_run, [''])
+
+test('return_mem_to_os', normal, compile_and_run, [''])
+
+test('4850', extra_clean(['4850.o','4850.hi','4850']),
+ run_command, ['$MAKE -s --no-print-directory 4850'])
+
+def config_5250(opts):
+ if not (config.arch in ['i386','x86_64']):
+ opts.skip = 1;
+
+test('5250', [ config_5250,
+ extra_clean(['spalign.o']),
+ omit_ways(['ghci']) ],
+ compile_and_run, ['spalign.c'])
+
diff --git a/testsuite/tests/rts/atomicinc.c b/testsuite/tests/rts/atomicinc.c
new file mode 100644
index 0000000000..8f1c8bf3ed
--- /dev/null
+++ b/testsuite/tests/rts/atomicinc.c
@@ -0,0 +1,21 @@
+#define THREADED_RTS
+
+#include "Rts.h"
+
+StgWord i;
+
+int main(int argc, char *argv[])
+{
+ StgWord j;
+
+ i = 0;
+ j = atomic_inc(&i);
+ CHECK(j == 1);
+ CHECK(i == 1);
+
+ j = atomic_dec(&i);
+ CHECK(j == 0);
+ CHECK(i == 0);
+
+ return 0;
+}
diff --git a/testsuite/tests/rts/bug1010.hs b/testsuite/tests/rts/bug1010.hs
new file mode 100644
index 0000000000..50329b738b
--- /dev/null
+++ b/testsuite/tests/rts/bug1010.hs
@@ -0,0 +1,16 @@
+module Main where
+
+break2 p (x:xs) = if p x then
+ ([],x:xs)
+ else
+ let (b1,b2) = break2 p xs
+ in (x : b1, b2)
+break2 p [] = ([],[])
+
+surprise xs = b1 ++ "\n surprise " ++ b2
+ where
+ (b1,b2) = break2 (=='\n') xs
+
+test n = length $ surprise $ [head (show i) | i <-[1..n] ] ++ "\n the end"
+
+main = print $ test 10000
diff --git a/testsuite/tests/rts/bug1010.stdout b/testsuite/tests/rts/bug1010.stdout
new file mode 100644
index 0000000000..8a0934b514
--- /dev/null
+++ b/testsuite/tests/rts/bug1010.stdout
@@ -0,0 +1 @@
+10020
diff --git a/testsuite/tests/rts/derefnull.hs b/testsuite/tests/rts/derefnull.hs
new file mode 100644
index 0000000000..474ff62c4c
--- /dev/null
+++ b/testsuite/tests/rts/derefnull.hs
@@ -0,0 +1,14 @@
+
+{-
+By default, on Windows a segfault will pop up an annoying dialog box.
+We want the RTS to catch it instead.
+-}
+
+module Main where
+
+import Foreign
+
+main :: IO ()
+main = do x <- peek nullPtr
+ print (x :: Int)
+
diff --git a/testsuite/tests/rts/derefnull.stderr-x86_64-unknown-openbsd b/testsuite/tests/rts/derefnull.stderr-x86_64-unknown-openbsd
new file mode 100644
index 0000000000..d1ecae163f
--- /dev/null
+++ b/testsuite/tests/rts/derefnull.stderr-x86_64-unknown-openbsd
@@ -0,0 +1 @@
+Segmentation fault
diff --git a/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 b/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32
new file mode 100644
index 0000000000..5f2034dd57
--- /dev/null
+++ b/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32
@@ -0,0 +1 @@
+Segmentation fault/access violation in generated code
diff --git a/testsuite/tests/rts/divbyzero.hs b/testsuite/tests/rts/divbyzero.hs
new file mode 100644
index 0000000000..0cf82bbae5
--- /dev/null
+++ b/testsuite/tests/rts/divbyzero.hs
@@ -0,0 +1,13 @@
+
+{-
+By default, on Windows a division-by-zero will pop up an annoying dialog box.
+We want the RTS to catch it instead.
+-}
+
+module Main where
+
+import GHC.Base
+
+main :: IO ()
+main = print (5 `divInt` 0)
+
diff --git a/testsuite/tests/rts/divbyzero.stderr-x86_64-unknown-openbsd b/testsuite/tests/rts/divbyzero.stderr-x86_64-unknown-openbsd
new file mode 100644
index 0000000000..da6f639f9d
--- /dev/null
+++ b/testsuite/tests/rts/divbyzero.stderr-x86_64-unknown-openbsd
@@ -0,0 +1 @@
+Floating point exception
diff --git a/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32 b/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32
new file mode 100644
index 0000000000..466709b368
--- /dev/null
+++ b/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32
@@ -0,0 +1 @@
+divide by zero
diff --git a/testsuite/tests/rts/exec_signals.hs b/testsuite/tests/rts/exec_signals.hs
new file mode 100644
index 0000000000..a9433d206a
--- /dev/null
+++ b/testsuite/tests/rts/exec_signals.hs
@@ -0,0 +1,20 @@
+import System.Process
+import System.Posix.Signals
+import Control.Monad(when)
+
+data SigState = Ignored | Default | Handled
+ deriving (Eq, Read, Show)
+
+data ChildInfo = ChildInfo {
+ masked :: [(Int,Bool)],
+ handlers :: [(Int, SigState)] }
+ deriving (Read, Show)
+
+main = do out <- readProcess "./exec_signals_child" [] ""
+ let ci = read out :: ChildInfo
+ blockedSigs = [x | (x, True) <- masked ci]
+ ignoredSigs = [x | (x, Ignored) <- handlers ci]
+ when (not $ null blockedSigs) $
+ putStrLn ("signals " ++ show blockedSigs ++ " are blocked")
+ when (not $ null ignoredSigs) $
+ putStrLn ("signals " ++ show ignoredSigs ++ " are ignored")
diff --git a/testsuite/tests/rts/exec_signals_child.c b/testsuite/tests/rts/exec_signals_child.c
new file mode 100644
index 0000000000..4b84008928
--- /dev/null
+++ b/testsuite/tests/rts/exec_signals_child.c
@@ -0,0 +1,47 @@
+#include <signal.h>
+#include <stdio.h>
+#include <errno.h>
+
+// Prints the state of the signal handlers to stdout
+int main()
+{
+ int open = 0, i;
+ sigset_t blockedsigs;
+
+ printf("ChildInfo { masked = [");
+
+ sigprocmask(SIG_BLOCK, NULL, &blockedsigs);
+ for(i = 0; i < NSIG; ++i)
+ {
+ int ret = sigismember(&blockedsigs, i);
+ if(ret >= 0)
+ {
+ if(!open)
+ open=1;
+ else
+ printf(",");
+ printf("(%d,%s)", i, ret == 1 ? "True" : "False");
+ }
+ }
+ printf("], handlers = [");
+
+ open = 0;
+ for(i = 0; i < NSIG; ++i)
+ {
+ struct sigaction old;
+ if(sigaction(i, NULL, &old) >= 0)
+ {
+ if(!open)
+ open=1;
+ else
+ printf(",");
+
+ printf("(%d,%s)", i,
+ old.sa_handler == SIG_IGN ? "Ignored" :
+ (old.sa_handler == SIG_DFL ? "Default" : "Handled"));
+ }
+ }
+ printf("]}");
+
+ return 0;
+}
diff --git a/testsuite/tests/rts/exec_signals_prepare.c b/testsuite/tests/rts/exec_signals_prepare.c
new file mode 100644
index 0000000000..26f30acc57
--- /dev/null
+++ b/testsuite/tests/rts/exec_signals_prepare.c
@@ -0,0 +1,29 @@
+#include <signal.h>
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+
+// Invokes a process, making sure that the state of the signal
+// handlers has all been set back to the unix default.
+int main(int argc, char **argv)
+{
+ int i;
+ sigset_t blockedsigs;
+ struct sigaction action;
+
+ // unblock all signals
+ sigemptyset(&blockedsigs);
+ sigprocmask(SIG_BLOCK, NULL, NULL);
+
+ // reset all signals to SIG_DFL
+ memset(&action, 0, sizeof(action));
+ action.sa_handler = SIG_DFL;
+ action.sa_flags = 0;
+ sigemptyset(&action.sa_mask);
+ for(i = 0; i < NSIG; ++i)
+ sigaction(i, &action, NULL);
+
+ execv(argv[1], argv+1);
+ fprintf(stderr, "failed to execv %s\n", argv[1]);
+ return 0;
+}
diff --git a/testsuite/tests/rts/libfoo_T2615.c b/testsuite/tests/rts/libfoo_T2615.c
new file mode 100644
index 0000000000..a83cb18e7a
--- /dev/null
+++ b/testsuite/tests/rts/libfoo_T2615.c
@@ -0,0 +1,2 @@
+void foo( void );
+void foo() {}
diff --git a/testsuite/tests/rts/libfoo_script_T2615.so b/testsuite/tests/rts/libfoo_script_T2615.so
new file mode 100644
index 0000000000..d744ae9604
--- /dev/null
+++ b/testsuite/tests/rts/libfoo_script_T2615.so
@@ -0,0 +1,5 @@
+/* GNU ld script
+ Use the shared library, but some functions are only in
+ the static library, so try that secondarily. */
+OUTPUT_FORMAT(elf64-x86-64)
+GROUP ( libfoo_T2615.so )
diff --git a/testsuite/tests/rts/outofmem.hs b/testsuite/tests/rts/outofmem.hs
new file mode 100644
index 0000000000..9392ab1da0
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.hs
@@ -0,0 +1,7 @@
+module Main where
+import Data.Array.IO
+import Control.Monad
+main = do
+ arrs <- sequence $ repeat $ (newArray_ (0,2^28) :: IO (IOUArray Int Int))
+ -- larger than 2^28 causes other problems...
+ print (length arrs)
diff --git a/testsuite/tests/rts/outofmem.stderr b/testsuite/tests/rts/outofmem.stderr
new file mode 100644
index 0000000000..81856a7544
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.stderr
@@ -0,0 +1 @@
+outofmem.exe: out of memory
diff --git a/testsuite/tests/rts/outofmem.stderr-i386-apple-darwin b/testsuite/tests/rts/outofmem.stderr-i386-apple-darwin
new file mode 100644
index 0000000000..929879a922
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.stderr-i386-apple-darwin
@@ -0,0 +1 @@
+outofmem: memory allocation failed (requested 1074790400 bytes)
diff --git a/testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32 b/testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32
new file mode 100644
index 0000000000..81856a7544
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.stderr-i386-unknown-mingw32
@@ -0,0 +1 @@
+outofmem.exe: out of memory
diff --git a/testsuite/tests/rts/outofmem.stderr-powerpc-apple-darwin b/testsuite/tests/rts/outofmem.stderr-powerpc-apple-darwin
new file mode 100644
index 0000000000..929879a922
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.stderr-powerpc-apple-darwin
@@ -0,0 +1 @@
+outofmem: memory allocation failed (requested 1074790400 bytes)
diff --git a/testsuite/tests/rts/outofmem.stderr-ws-32 b/testsuite/tests/rts/outofmem.stderr-ws-32
new file mode 100644
index 0000000000..6147d23e91
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.stderr-ws-32
@@ -0,0 +1 @@
+outofmem: out of memory (requested 1074790400 bytes)
diff --git a/testsuite/tests/rts/outofmem.stderr-ws-64 b/testsuite/tests/rts/outofmem.stderr-ws-64
new file mode 100644
index 0000000000..42a4696fcf
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.stderr-ws-64
@@ -0,0 +1 @@
+outofmem: out of memory (requested 2148532224 bytes)
diff --git a/testsuite/tests/rts/outofmem.stdout b/testsuite/tests/rts/outofmem.stdout
new file mode 100644
index 0000000000..63a3a6988c
--- /dev/null
+++ b/testsuite/tests/rts/outofmem.stdout
@@ -0,0 +1 @@
+exit(1)
diff --git a/testsuite/tests/rts/outofmem2.hs b/testsuite/tests/rts/outofmem2.hs
new file mode 100644
index 0000000000..b206d7147e
--- /dev/null
+++ b/testsuite/tests/rts/outofmem2.hs
@@ -0,0 +1,10 @@
+-- Test for bug #1791
+import Control.Monad.ST
+import Data.Array.ST
+import Data.Array.MArray
+import Data.Array.Base(unsafeNewArray_)
+main = print (runST (do make_empty_table >> return ()))
+
+make_empty_table:: ST s (STArray s (Int, Int) (Maybe ep))
+make_empty_table =
+ unsafeNewArray_ ((1, 1), (16384, 16384))
diff --git a/testsuite/tests/rts/outofmem2.stderr b/testsuite/tests/rts/outofmem2.stderr
new file mode 100644
index 0000000000..5fa8ba00e7
--- /dev/null
+++ b/testsuite/tests/rts/outofmem2.stderr
@@ -0,0 +1,3 @@
+Heap exhausted;
+Current maximum heap size is 5242880 bytes (5 MB);
+use `+RTS -M<size>' to increase it.
diff --git a/testsuite/tests/rts/outofmem2.stdout b/testsuite/tests/rts/outofmem2.stdout
new file mode 100644
index 0000000000..1acdde769d
--- /dev/null
+++ b/testsuite/tests/rts/outofmem2.stdout
@@ -0,0 +1 @@
+exit(251)
diff --git a/testsuite/tests/rts/return_mem_to_os.hs b/testsuite/tests/rts/return_mem_to_os.hs
new file mode 100644
index 0000000000..242ccc3bb0
--- /dev/null
+++ b/testsuite/tests/rts/return_mem_to_os.hs
@@ -0,0 +1,21 @@
+
+import Control.Concurrent
+import System.IO
+import System.Mem
+
+main :: IO ()
+main = do hSetBuffering stdout LineBuffering
+ mapM_ doIter [1..3]
+
+doIter :: Int -> IO ()
+doIter n = do putStrLn ("Iteration " ++ show n)
+ let xs = [n .. 1000000 + n]
+ putStrLn ("Last: " ++ show (last xs))
+ putStrLn "GC 1 start"
+ performGC
+ putStrLn "GC 1 done"
+ putStrLn ("Head: " ++ show (head xs))
+ putStrLn "GC 2 start"
+ performGC
+ putStrLn "GC 2 done"
+
diff --git a/testsuite/tests/rts/return_mem_to_os.stdout b/testsuite/tests/rts/return_mem_to_os.stdout
new file mode 100644
index 0000000000..01ddffa89e
--- /dev/null
+++ b/testsuite/tests/rts/return_mem_to_os.stdout
@@ -0,0 +1,21 @@
+Iteration 1
+Last: 1000001
+GC 1 start
+GC 1 done
+Head: 1
+GC 2 start
+GC 2 done
+Iteration 2
+Last: 1000002
+GC 1 start
+GC 1 done
+Head: 2
+GC 2 start
+GC 2 done
+Iteration 3
+Last: 1000003
+GC 1 start
+GC 1 done
+Head: 3
+GC 2 start
+GC 2 done
diff --git a/testsuite/tests/rts/rtsflags001.hs b/testsuite/tests/rts/rtsflags001.hs
new file mode 100644
index 0000000000..b3549c2fe3
--- /dev/null
+++ b/testsuite/tests/rts/rtsflags001.hs
@@ -0,0 +1 @@
+main = return ()
diff --git a/testsuite/tests/rts/rtsflags001.stderr-ws-32 b/testsuite/tests/rts/rtsflags001.stderr-ws-32
new file mode 100644
index 0000000000..2bdd8ab066
--- /dev/null
+++ b/testsuite/tests/rts/rtsflags001.stderr-ws-32
@@ -0,0 +1 @@
+rtsflags001: error in RTS option -H0m: size outside allowed range (4096 - 4294967295)
diff --git a/testsuite/tests/rts/rtsflags001.stderr-ws-64 b/testsuite/tests/rts/rtsflags001.stderr-ws-64
new file mode 100644
index 0000000000..f50a3ee22b
--- /dev/null
+++ b/testsuite/tests/rts/rtsflags001.stderr-ws-64
@@ -0,0 +1 @@
+rtsflags001: error in RTS option -H0m: size outside allowed range (4096 - 18446744073709551615)
diff --git a/testsuite/tests/rts/spalign.c b/testsuite/tests/rts/spalign.c
new file mode 100644
index 0000000000..0b776e17cc
--- /dev/null
+++ b/testsuite/tests/rts/spalign.c
@@ -0,0 +1,30 @@
+#include "Rts.h"
+
+#ifdef darwin_HOST_OS
+#define STG_GLOBAL ".globl "
+#else
+#define STG_GLOBAL ".global "
+#endif
+
+#ifdef LEADING_UNDERSCORE
+#define GETESP "_getesp"
+#else
+#define GETESP "getesp"
+#endif
+
+void __dummy__(void)
+{
+ __asm__ volatile (
+ STG_GLOBAL GETESP "\n"
+ GETESP ":\n\t"
+
+#if defined(i386_HOST_ARCH)
+ "movl %%esp, %%eax\n\t"
+#elif defined(x86_64_HOST_ARCH)
+ "movq %%rsp, %%rax\n\t"
+#else
+#error splign.c: not implemented for this architecture
+#endif
+ "ret"
+ : : );
+}
diff --git a/testsuite/tests/rts/stack001.hs b/testsuite/tests/rts/stack001.hs
new file mode 100644
index 0000000000..4676e046ac
--- /dev/null
+++ b/testsuite/tests/rts/stack001.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import Control.Concurrent
+import Control.Exception
+
+main = do
+ -- stack will grow as we evaluate the expression, and then shrink again
+ evaluate $ foldr (+) 0 [1..200000]
+ threadDelay 10 -- allow stack to shrink back to its smallest size
diff --git a/testsuite/tests/rts/stack002.hs b/testsuite/tests/rts/stack002.hs
new file mode 100644
index 0000000000..e6c8ee8d69
--- /dev/null
+++ b/testsuite/tests/rts/stack002.hs
@@ -0,0 +1,2 @@
+{-# LANGUAGE CPP #-}
+#include "stack001.hs"
diff --git a/testsuite/tests/rts/stack003.hs b/testsuite/tests/rts/stack003.hs
new file mode 100644
index 0000000000..4b6b29fa8d
--- /dev/null
+++ b/testsuite/tests/rts/stack003.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Exts
+import System.Environment
+
+main = do
+ [n] <- fmap (fmap read) getArgs
+ case g n of
+ (# a, b, c, d, e, f, g, h, i #) -> print a
+
+-- a deep stack in which each frame is an unboxed tuple-return, to exercise
+-- the stack underflow machinery.
+g :: Int -> (# Int,Float,Double,Int#,Float#,Double#,Int,Float,Double #)
+g 0 = (# 1, 2.0, 3.0, 1#, 2.0#, 3.0##, 1, 2.0, 3.0 #)
+g x = case g (x-1) of
+ (# a, b, c, d, e, f, g, h, i #) ->
+ (# a+1, b, c, d, e, f, g, h, i #)
diff --git a/testsuite/tests/rts/stack003.stdout b/testsuite/tests/rts/stack003.stdout
new file mode 100644
index 0000000000..1567408305
--- /dev/null
+++ b/testsuite/tests/rts/stack003.stdout
@@ -0,0 +1 @@
+500001
diff --git a/testsuite/tests/rts/testblockalloc.c b/testsuite/tests/rts/testblockalloc.c
new file mode 100644
index 0000000000..5ccc14bf59
--- /dev/null
+++ b/testsuite/tests/rts/testblockalloc.c
@@ -0,0 +1,75 @@
+#include "Rts.h"
+
+#include <stdio.h>
+
+extern bdescr *allocGroup_lock_lock(nat n);
+extern void freeGroup_lock(bdescr *p);
+
+const int ARRSIZE = 256;
+const int LOOPS = 100;
+const int MAXALLOC = ((8 * 1024 * 1024) / BLOCK_SIZE - 1);
+//const int MAXALLOC = ((64 * 1024 * 1024) / BLOCK_SIZE - 1);
+const int SEED = 0xf00f00;
+
+extern lnat mblocks_allocated;
+
+int main (int argc, char *argv[])
+{
+ int i, j, b;
+
+ bdescr *a[ARRSIZE];
+
+ srand(SEED);
+
+ hs_init(&argc, &argv);
+
+ // repeatedly sweep though the array, allocating new random-sized
+ // objects and deallocating the old ones.
+ for (i=0; i < LOOPS; i++)
+ {
+ for (j=0; j < ARRSIZE; j++)
+ {
+ if (i > 0)
+ {
+ IF_DEBUG(block_alloc, debugBelch("A%d: freeing %p, %d blocks @ %p\n", j, a[j], a[j]->blocks, a[j]->start));
+ freeGroup_lock(a[j]);
+ DEBUG_ONLY(checkFreeListSanity());
+ }
+ b = (rand() % MAXALLOC) + 1;
+ a[j] = allocGroup_lock(b);
+ IF_DEBUG(block_alloc, debugBelch("A%d: allocated %p, %d blocks @ %p\n", j, a[j], b, a[j]->start));
+ // allocating zero blocks isn't allowed
+ DEBUG_ONLY(checkFreeListSanity());
+ }
+ }
+
+ for (j=0; j < ARRSIZE; j++)
+ {
+ freeGroup_lock(a[j]);
+ }
+
+ // this time, sweep forwards allocating new blocks, and then
+ // backwards deallocating them.
+ for (i=0; i < LOOPS; i++)
+ {
+ for (j=0; j < ARRSIZE; j++)
+ {
+ b = (rand() % MAXALLOC) + 1;
+ a[j] = allocGroup_lock(b);
+ IF_DEBUG(block_alloc, debugBelch("B%d,%d: allocated %p, %d blocks @ %p\n", i, j, a[j], b, a[j]->start));
+ DEBUG_ONLY(checkFreeListSanity());
+ }
+ for (j=ARRSIZE-1; j >= 0; j--)
+ {
+ IF_DEBUG(block_alloc, debugBelch("B%d,%d: freeing %p, %d blocks @ %p\n", i, j, a[j], a[j]->blocks, a[j]->start));
+ freeGroup_lock(a[j]);
+ DEBUG_ONLY(checkFreeListSanity());
+ }
+ }
+
+ DEBUG_ONLY(checkFreeListSanity());
+
+ hs_exit(); // will do a memory leak test
+
+ exit(0);
+}
diff --git a/testsuite/tests/rts/testheapalloced.c b/testsuite/tests/rts/testheapalloced.c
new file mode 100644
index 0000000000..cc4dad40d4
--- /dev/null
+++ b/testsuite/tests/rts/testheapalloced.c
@@ -0,0 +1,100 @@
+#include "Rts.h"
+#include "RtsFlags.h"
+#ifdef DEBUG
+#define INLINE_HEADER
+#endif
+#include "MBlock.h"
+#ifdef DEBUG
+extern void *getFirstMBlock(void);
+extern void *getNextMBlock(void *mblock);
+#endif
+
+#include <stdio.h>
+#include <string.h>
+
+extern bdescr *allocGroup_lock_lock(nat n);
+extern void freeGroup_lock(bdescr *p);
+
+const int ARRSIZE = 2000;
+const int LOOPS = 20000;
+const int MAXALLOC = ((8 * 1024 * 1024) / BLOCK_SIZE - 1);
+//const int MAXALLOC = ((4 * 1024 * 1024) / BLOCK_SIZE - 1);
+const int SEED = 0xf00f00;
+
+extern lnat mblocks_allocated;
+
+int main (int argc, char *argv[])
+{
+ int i, j, b;
+
+ bdescr *a[ARRSIZE];
+
+ srand(SEED);
+
+ hs_init(&argc, &argv);
+
+ memset(a, 0, ARRSIZE * sizeof(bdescr*));
+
+ for (i=0; i < LOOPS; i++)
+ {
+ j = rand() % ARRSIZE;
+ if (a[j]) { freeGroup_lock(a[j]); }
+ a[j] = allocGroup_lock(rand() % MAXALLOC + 1);
+ }
+
+#ifdef DEBUG
+ {
+ void *p;
+ i = 0;
+ for (p = getFirstMBlock(); p != NULL; p = getNextMBlock(p))
+ {
+ if (!HEAP_ALLOCED(p)) barf("%p",p);
+ i++;
+ }
+ printf("%d\n", i);
+ }
+#endif
+
+ {
+ void *p, *base;
+
+ j = 0;
+ base = RtsFlags.GcFlags.heapBase;
+
+ for (i=0; i < LOOPS*2000; i++)
+ {
+ // this is for testing: generate random addresses anywhere
+ // in the address space.
+ //
+ // 48 bits is: 0x800000000000 - 0x7fffffffffff
+ // so ((StgInt)rand() >> 4) varies between -2^27 and 2^27-1.
+ // and << 20 of this is a random signed 48-bit megablock address
+ //
+ // p = (void*)((StgWord)((StgInt)rand() >> 4) << 20);
+
+ // this is for benchmarking: roughly half of these
+ // addresses will be in the heap.
+ p = base + (((StgWord)rand() << 10) %
+ ((StgWord)ARRSIZE * MAXALLOC * BLOCK_SIZE));
+
+ if (HEAP_ALLOCED(p)) {
+ // printf("%p\n",p);
+ j++;
+ }
+ }
+ printf("%d\n", j);
+ }
+
+ printf("misses: %ld, %ld%\n", mpc_misses, mpc_misses / (LOOPS*20));
+
+ for (i=0; i < ARRSIZE; i++)
+ {
+ if (a[i]) { freeGroup_lock(a[i]); }
+ }
+
+ hs_exit(); // will do a memory leak test
+
+ exit(0);
+}
+
+// 48 bits is: 0x800000000000 - 0x7fffffffffff
diff --git a/testsuite/tests/rts/testwsdeque.c b/testsuite/tests/rts/testwsdeque.c
new file mode 100644
index 0000000000..51aeec1ca4
--- /dev/null
+++ b/testsuite/tests/rts/testwsdeque.c
@@ -0,0 +1,167 @@
+#define THREADED_RTS
+
+#include "Rts.h"
+#include "WSDeque.h"
+#include <stdio.h>
+
+#define SCRATCH_SIZE (1024*1024)
+#define THREADS 3
+#define POP 2
+
+WSDeque *q;
+
+StgWord scratch[SCRATCH_SIZE];
+StgWord done;
+
+OSThreadId ids[THREADS];
+
+// -----------------------------------------------------------------------------
+// version of stealWSDeque() that logs its actions, for debugging
+
+#ifdef DEBUG
+
+#define BUF 128
+
+int bufs[THREADS];
+
+StgWord last_b[THREADS][BUF];
+StgWord last_t[THREADS][BUF];
+StgWord last_v[THREADS][BUF];
+
+#define CASTOP(addr,old,new) ((old) == cas(((StgPtr)addr),(old),(new)))
+
+void *
+myStealWSDeque_ (WSDeque *q, nat n)
+{
+ void * stolen;
+ StgWord b,t;
+
+// Can't do this on someone else's spark pool:
+// ASSERT_WSDEQUE_INVARIANTS(q);
+
+ // NB. these loads must be ordered, otherwise there is a race
+ // between steal and pop.
+ t = q->top;
+ load_load_barrier();
+ b = q->bottom;
+
+ // NB. b and t are unsigned; we need a signed value for the test
+ // below, because it is possible that t > b during a
+ // concurrent popWSQueue() operation.
+ if ((long)b - (long)t <= 0 ) {
+ return NULL; /* already looks empty, abort */
+ }
+
+ /* now access array, see pushBottom() */
+ stolen = q->elements[t & q->moduloSize];
+
+ /* now decide whether we have won */
+ if ( !(CASTOP(&(q->top),t,t+1)) ) {
+ /* lost the race, someon else has changed top in the meantime */
+ return NULL;
+ } /* else: OK, top has been incremented by the cas call */
+
+ // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b);
+
+// Can't do this on someone else's spark pool:
+// ASSERT_WSDEQUE_INVARIANTS(q);
+
+ bufs[n] ++;
+ if (bufs[n] == BUF) { bufs[n] = 0; }
+ last_b[n][bufs[n]] = b;
+ last_t[n][bufs[n]] = t;
+ last_v[n][bufs[n]] = (StgWord)stolen;
+ return stolen;
+}
+
+void *
+myStealWSDeque (WSDeque *q, nat n)
+{
+ void *stolen;
+
+ do {
+ stolen = myStealWSDeque_(q,n);
+ } while (stolen == NULL && !looksEmptyWSDeque(q));
+
+ return stolen;
+}
+
+void dump(void)
+{
+ nat n;
+ nat i;
+ for (n = 0; n < THREADS; n++) {
+ debugBelch("\nthread %d:\n", n);
+ for (i = bufs[n]; i >= stg_max(bufs[n]-20,0); i--) {
+ debugBelch("%d: t=%ld b=%ld = %ld\n", i, last_t[n][i], last_b[n][i], last_v[n][i]);
+ }
+ }
+}
+
+#endif // DEBUG
+
+// -----------------------------------------------------------------------------
+
+void work(void *p, nat n)
+{
+ StgWord val;
+
+ // debugBelch("work %ld %d\n", p, n);
+ val = *(StgWord *)p;
+ if (val != 0) {
+ fflush(stdout);
+ fflush(stderr);
+ barf("FAIL: %ld %d %d", p, n, val);
+ }
+ *(StgWord*)p = n+10;
+}
+
+void OSThreadProcAttr thief(void *info)
+{
+ void *p;
+ StgWord n;
+ nat count = 0;
+
+ n = (StgWord)info;
+
+ while (!done) {
+#ifdef DEBUG
+ p = myStealWSDeque(q,n);
+#else
+ p = stealWSDeque(q);
+#endif
+ if (p != NULL) { work(p,n+1); count++; }
+ }
+ debugBelch("thread %ld finished, stole %d", n, count);
+}
+
+int main(int argc, char*argv[])
+{
+ int n;
+ nat count = 0;
+ void *p;
+
+ q = newWSDeque(1024);
+ done = 0;
+
+ for (n=0; n < SCRATCH_SIZE; n++) {
+ scratch[n] = 0;
+ }
+
+ for (n=0; n < THREADS; n++) {
+ createOSThread(&ids[n], thief, (void*)(StgWord)n);
+ }
+
+ for (n=0; n < SCRATCH_SIZE; n++) {
+ if (n % POP) {
+ p = popWSDeque(q);
+ if (p != NULL) { work(p,0); count++; }
+ }
+ pushWSDeque(q,&scratch[n]);
+ }
+
+#ifdef DEBUG
+ debugBelch("main thread finished, popped %d", count);
+#endif
+ exit(0);
+}
diff --git a/testsuite/tests/rts/traceEvent.hs b/testsuite/tests/rts/traceEvent.hs
new file mode 100644
index 0000000000..ef641816d4
--- /dev/null
+++ b/testsuite/tests/rts/traceEvent.hs
@@ -0,0 +1,5 @@
+import GHC.Exts
+
+main = do
+ traceEvent "testing"
+ traceEvent "%s" -- see #3874
View Lorry Controller Status