From: simonm <unknown>
Date: Thu, 4 Jun 1998 16:15:20 +0000 (+0000)
Subject: [project @ 1998-06-04 16:15:10 by simonm]
X-Git-Tag: Approx_2487_patches~633
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=84501c25a4a1f1e54fc917782f744c3c682d98f9;p=ghc-hetmet.git

[project @ 1998-06-04 16:15:10 by simonm]
Add a few simple concurrency tests.  More to come.
---

diff --git a/ghc/tests/concurrent/Makefile b/ghc/tests/concurrent/Makefile
new file mode 100644
index 0000000..2d0e394
--- /dev/null
+++ b/ghc/tests/concurrent/Makefile
@@ -0,0 +1,11 @@
+#-----------------------------------------------------------------------------
+# $Id: Makefile,v 1.1 1998/06/04 16:15:10 simonm Exp $
+
+TOP = ..
+include $(TOP)/mk/boilerplate.mk
+
+SUBDIRS = should_run
+
+include $(TOP)/mk/target.mk
+
+
diff --git a/ghc/tests/concurrent/should_run/conc001.hs b/ghc/tests/concurrent/should_run/conc001.hs
new file mode 100644
index 0000000..8f7f3fe
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc001.hs
@@ -0,0 +1,15 @@
+module Main where
+
+import Concurrent
+
+-- two processes, one MVar communication.
+
+main = do
+  s <- newEmptyMVar
+  let 
+    reader = do
+	str <- takeMVar s
+  	putStr str
+
+  forkIO reader
+  putMVar s "hello world\n"
diff --git a/ghc/tests/concurrent/should_run/conc001.stdout b/ghc/tests/concurrent/should_run/conc001.stdout
new file mode 100644
index 0000000..3b18e51
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc001.stdout
@@ -0,0 +1 @@
+hello world
diff --git a/ghc/tests/concurrent/should_run/conc002.hs b/ghc/tests/concurrent/should_run/conc002.hs
new file mode 100644
index 0000000..4e876f8
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc002.hs
@@ -0,0 +1,15 @@
+module Main where
+
+import Concurrent
+
+main = do
+  c <- newChan
+  let 
+    reader = do
+	char <- readChan c
+  	if (char == '\n') 
+		then return () 
+		else do	putChar char; reader	
+  forkIO reader
+  writeList2Chan c "Hello World\n"
+
diff --git a/ghc/tests/concurrent/should_run/conc002.stdout b/ghc/tests/concurrent/should_run/conc002.stdout
new file mode 100644
index 0000000..5e1c309
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc002.stdout
@@ -0,0 +1 @@
+Hello World
\ No newline at end of file
diff --git a/ghc/tests/concurrent/should_run/conc003.hs b/ghc/tests/concurrent/should_run/conc003.hs
new file mode 100644
index 0000000..dcd7222
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc003.hs
@@ -0,0 +1,28 @@
+module Main where
+
+import Concurrent
+
+-- simple handshaking using two MVars, 
+-- must context switch twice for each character.
+
+main = do
+  ready <- newEmptyMVar
+  datum <- newEmptyMVar
+  let 
+    reader = do
+	putMVar ready ()
+	char <- takeMVar datum
+  	if (char == '\n') 
+		then return () 
+		else do	putChar char; reader
+
+    writer "" = do
+	takeMVar ready
+	putMVar datum '\n'
+    writer (c:cs) = do
+	takeMVar ready
+	putMVar datum c
+	writer cs
+
+  forkIO reader
+  writer "Hello World"
diff --git a/ghc/tests/concurrent/should_run/conc003.stdout b/ghc/tests/concurrent/should_run/conc003.stdout
new file mode 100644
index 0000000..5e1c309
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc003.stdout
@@ -0,0 +1 @@
+Hello World
\ No newline at end of file