Merge pull request #1714 from edwinb/lodi-thread-data

fix arity for blodwen-set-thread-data

Makefile

@@ -114,6 +114,8 @@ ${TEST_PREFIX}/${NAME_VERSION} :
 	ln -s ${IDRIS2_CURDIR}/libs/network/build/ttc ${TEST_PREFIX}/${NAME_VERSION}/network-${IDRIS2_VERSION}
 endif
 
+.PHONY: ${TEST_PREFIX}/${NAME_VERSION}
+
 testenv:
 	@${MAKE} ${TEST_PREFIX}/${NAME_VERSION}
 	@${MAKE} -C tests testbin IDRIS2=${TARGET} IDRIS2_PREFIX=${TEST_PREFIX}

support/chez/support.ss

@@ -257,7 +257,7 @@
 (define (blodwen-get-thread-data ty)
   (blodwen-thread-data))
 
-(define (blodwen-set-thread-data a)
+(define (blodwen-set-thread-data ty a)
   (blodwen-thread-data a))
 
 ;; Semaphore

support/gambit/support.scm

@@ -192,7 +192,7 @@
   (let ((data (thread-specific (current-thread))))
     (if (eq? data #!void) #f data)))
 
-(define (blodwen-set-thread-data a)
+(define (blodwen-set-thread-data ty a)
   (thread-specific-set! (current-thread) a))
 
 (define blodwen-mutex make-mutex)

support/racket/support.rkt

@@ -249,7 +249,7 @@
 (define (blodwen-get-thread-data ty)
   (thread-cell-ref blodwen-thread-data))
 
-(define (blodwen-set-thread-data a)
+(define (blodwen-set-thread-data ty a)
   (thread-cell-set! blodwen-thread-data a))
 
 ;; Semaphores

tests/Main.idr

@@ -213,7 +213,7 @@ chezTests = MkTestPool "Chez backend" [] (Just Chez)
     , "chez013", "chez014", "chez015", "chez016", "chez017", "chez018"
     , "chez019", "chez020", "chez021", "chez022", "chez023", "chez024"
     , "chez025", "chez026", "chez027", "chez028", "chez029", "chez030"
-    , "chez031", "chez032", "chez033"
+    , "chez031", "chez032", "chez033", "chez034"
     , "futures001"
     , "bitops"
     , "casts"

tests/chez/chez034/ThreadData.idr

@@ -0,0 +1,48 @@
+module Main
+
+import System.Concurrency
+
+child : Condition -> Mutex -> IO ()
+child cond mtx = do
+    mutexAcquire mtx
+    str <- getThreadData String
+    putStrLn $ "child data: " ++ (show str)
+
+    setThreadData 17
+    i <- getThreadData Int
+    putStrLn $ "child data now: " ++ (show i)
+
+    conditionSignal cond
+    conditionWait cond mtx
+
+    putStrLn $ "child exiting"
+
+    conditionSignal cond
+    mutexRelease mtx
+
+
+main : IO ()
+main = do
+    setThreadData 13
+    i <- getThreadData Int
+    putStrLn $ "parent data initialized to: " ++ (show i)
+
+    setThreadData "hello"
+    str <- getThreadData String
+    putStrLn $ "parent data now: " ++ (show str)
+
+    mtx <- makeMutex
+    cond <- makeCondition
+
+    mutexAcquire mtx
+    _ <- fork (child cond mtx)
+    conditionWait cond mtx
+
+    str2 <- getThreadData String
+    putStrLn $ "parent data still: " ++ (show str2)
+
+    conditionSignal cond
+    conditionWait cond mtx
+
+    putStrLn $ "parent exiting"
+    mutexRelease mtx

tests/chez/chez034/expected

@@ -0,0 +1,9 @@
+1/1: Building ThreadData (ThreadData.idr)
+Main> parent data initialized to: 13
+parent data now: "hello"
+child data: "hello"
+child data now: 17
+parent data still: "hello"
+child exiting
+parent exiting
+Main> Bye for now!

tests/chez/chez034/input

@@ -0,0 +1,2 @@
+:exec main
+:q

tests/chez/chez034/run

@@ -0,0 +1,4 @@
+rm -rf build
+
+$1 --no-banner --no-color --console-width 0 ThreadData.idr < input
+