From 84501c25a4a1f1e54fc917782f744c3c682d98f9 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Thu, 4 Jun 1998 16:15:20 +0000
Subject: [PATCH] [project @ 1998-06-04 16:15:10 by simonm] Add a few simple
 concurrency tests.  More to come.

---
 ghc/tests/concurrent/Makefile                  |   11 ++++++++++
 ghc/tests/concurrent/should_run/conc001.hs     |   15 +++++++++++++
 ghc/tests/concurrent/should_run/conc001.stdout |    1 +
 ghc/tests/concurrent/should_run/conc002.hs     |   15 +++++++++++++
 ghc/tests/concurrent/should_run/conc002.stdout |    1 +
 ghc/tests/concurrent/should_run/conc003.hs     |   28 ++++++++++++++++++++++++
 ghc/tests/concurrent/should_run/conc003.stdout |    1 +
 7 files changed, 72 insertions(+)
 create mode 100644 ghc/tests/concurrent/Makefile
 create mode 100644 ghc/tests/concurrent/should_run/conc001.hs
 create mode 100644 ghc/tests/concurrent/should_run/conc001.stdout
 create mode 100644 ghc/tests/concurrent/should_run/conc002.hs
 create mode 100644 ghc/tests/concurrent/should_run/conc002.stdout
 create mode 100644 ghc/tests/concurrent/should_run/conc003.hs
 create mode 100644 ghc/tests/concurrent/should_run/conc003.stdout

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