RegressionTests__PipeStreamTest.st
changeset 1109 ad8866ade273
parent 1082 a46d9682d459
child 1110 a38d8f5208fd
--- a/RegressionTests__PipeStreamTest.st	Wed Mar 26 18:41:43 2014 +0100
+++ b/RegressionTests__PipeStreamTest.st	Thu Mar 27 17:26:13 2014 +0100
@@ -12,6 +12,51 @@
 
 !PipeStreamTest methodsFor:'tests'!
 
+testPipeWriteRead
+    | makeReader makeWriter count threads ok blocker |
+
+    count := 1000.
+    threads := 200.
+    ok := true.
+    blocker := Semaphore new: threads negated + 1.
+    makeReader := [ :stream | 
+        [
+            | c |
+            c := 0.
+            [ stream atEnd ] whileFalse:[ 
+                stream next.
+                c := c + 1.
+            ].
+            ok := ok and:[ count == c ].
+            blocker signal.
+        ].
+    ].
+
+    makeWriter := [ :stream | 
+        [ 
+            [ count timesRepeat:[stream nextPut: $P] ] on: Error do:[ 
+                ok := false 
+            ]
+        ]
+    ].
+
+    threads timesRepeat:[
+       | pipe rs ws|
+
+        pipe := NonPositionableExternalStream makePipe.
+        rs := pipe at:1.
+        ws := pipe at:2.     
+
+        (makeReader value: rs) fork.
+        (makeWriter value: ws) fork.
+    ].
+
+    blocker wait.
+    self assert: ok.
+
+    "Created: / 27-03-2014 / 16:21:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 testReadCheckPipe4
     "readCheck a pipe.
      Do this and interrupt the reading thread heavily"