fix arity for blodwen-set-thread-data

This is an update of PR #540, thanks to @lodi
This commit is contained in:
Edwin Brady 2021-07-15 15:02:43 +01:00
parent 8cd265cf47
commit 62586627d8
7 changed files with 67 additions and 2 deletions

View File

@ -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}

View File

@ -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

View File

@ -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"

View File

@ -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

View File

@ -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!

2
tests/chez/chez034/input Normal file
View File

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

4
tests/chez/chez034/run Normal file
View File

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