RegressionTests__PipeStreamTest.st
changeset 2009 f99d1003cfd9
parent 1906 a7f11abb9d19
equal deleted inserted replaced
2008:4cfa2ec59dcc 2009:f99d1003cfd9
    13 
    13 
    14 
    14 
    15 !PipeStreamTest methodsFor:'tests'!
    15 !PipeStreamTest methodsFor:'tests'!
    16 
    16 
    17 testPipeWriteRead
    17 testPipeWriteRead
    18     | makeReader makeWriter count threads ok blocker|
    18     | makeReader makeWriter count threads ok finished blocker|
    19 
    19 
    20     count := 1000.
    20     count := 1000.
    21     threads := 200.
    21     threads := 200.
    22     "/ There's limit to 50 open files in BCC5.5 libc, sigh.
    22     "/ There's limit to 50 open files in BCC5.5 libc, sigh.
    23     OperatingSystem isMSWINDOWSlike ifTrue:[
    23     OperatingSystem isMSWINDOWSlike ifTrue:[
    24 	threads := 20.
    24         threads := 20.
    25     ].
    25     ].
       
    26 
       
    27     finished := false.
    26     ok := true.
    28     ok := true.
    27     blocker := Semaphore new: 2 - threads.
    29     blocker := Semaphore new: 2 - threads.
    28 
    30 
    29     makeReader := [:stream |
    31     makeReader := [:stream |
    30 	    [
    32             [
    31 		| c |
    33                 | c |
    32 		c := 0.
    34                 c := 0.
    33 		[ stream atEnd ] whileFalse:[
    35                 [ stream atEnd ] whileFalse:[
    34 		    stream next.
    36                     stream next.
    35 		    c := c + 1.
    37                     c := c + 1.
    36 		].
    38                 ].
    37 		stream close.
    39                 stream close.
    38 		ok := ok and:[ count == c ].
    40                 ok := ok and:[ count == c ].
    39 		blocker signal.
    41                 blocker signal.
    40 	    ]
    42             ]
    41 	].
    43         ].
    42 
    44 
    43     makeWriter := [:stream |
    45     makeWriter := [:stream |
    44 	    [
    46             [
    45 		[
    47                 [
    46 		    count timesRepeat:[stream nextPut: $P]
    48                     count timesRepeat:[stream nextPut: $P]
    47 		] on: Error do:[
    49                 ] on: Error do:[
    48 		    ok := false
    50                     ok := false
    49 		].
    51                 ].
    50 		stream close.
    52                 stream close.
    51 	    ]
    53             ]
    52 	].
    54         ].
    53 
    55 
    54     threads timesRepeat:[
    56     [    
    55 	|pipe rs ws|
    57         threads timesRepeat:[
    56 
    58             |pipe rs ws|
    57 	pipe := NonPositionableExternalStream makePipe.
    59 
    58 	rs := pipe at:1.
    60             pipe := NonPositionableExternalStream makePipe.
    59 	ws := pipe at:2.
    61             rs := pipe at:1.
    60 
    62             ws := pipe at:2.
    61 	(makeReader value: rs) fork.
    63 
    62 	(makeWriter value: ws) fork.
    64             (makeReader value: rs) fork.
    63     ].
    65             (makeWriter value: ws) fork.
    64 
    66         ].
    65     blocker wait.
    67 
    66     self assert: ok.
    68         blocker wait.
       
    69         finished := true.
       
    70     ] valueWithTimeout:3 minutes.
       
    71     
       
    72     self assert:(finished and:[ok]).
    67 
    73 
    68     "Created: / 27-03-2014 / 16:21:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    74     "Created: / 27-03-2014 / 16:21:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
       
    75     "Modified: / 17-09-2018 / 15:30:19 / Claus Gittinger"
    69 !
    76 !
    70 
    77 
    71 testReadCheckPipe4
    78 testReadCheckPipe4
    72     "readCheck a pipe.
    79     "readCheck a pipe.
    73      Do this and interrupt the reading thread heavily"
    80      Do this and interrupt the reading thread heavily"