diff --git a/ghc/tests/concurrent/Makefile b/ghc/tests/concurrent/Makefile
new file mode 100644
index 0000000000000000000000000000000000000000..2d0e3940a182f3129e273b7329b47acac1805bbf
--- /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 0000000000000000000000000000000000000000..8f7f3fef7b41cd841f1a1516956f32441e8e8ccd
--- /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 0000000000000000000000000000000000000000..3b18e512dba79e4c8300dd08aeb37f8e728b8dad
--- /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 0000000000000000000000000000000000000000..4e876f89548cd409ad7691b90d0cbdf57ba7a640
--- /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 0000000000000000000000000000000000000000..5e1c309dae7f45e0f39b1bf3ac3cd9db12e7d689
--- /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 0000000000000000000000000000000000000000..dcd7222c47db90b6768a1055502b86f21c422d2e
--- /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 0000000000000000000000000000000000000000..5e1c309dae7f45e0f39b1bf3ac3cd9db12e7d689
--- /dev/null
+++ b/ghc/tests/concurrent/should_run/conc003.stdout
@@ -0,0 +1 @@
+Hello World
\ No newline at end of file