@@ -0,0 +1,47 @@
1+module BufferPoolSpec where
2+
3+import qualified Data.ByteString as B
4+import qualified Data.ByteString.Internal as B (ByteString(PS))
5+import Foreign.ForeignPtr (withForeignPtr)
6+import Foreign.Marshal.Utils (copyBytes)
7+import Foreign.Ptr (plusPtr)
8+
9+import Test.Hspec (Spec, hspec, shouldBe, describe, it)
10+
11+import Network.Wai.Handler.Warp.Buffer
12+ ( bufferSize
13+ , newBufferPool
14+ , withBufferPool
15+ )
16+import Network.Wai.Handler.Warp.Types (Buffer, BufSize)
17+
18+main :: IO ()
19+main = hspec spec
20+
21+-- Two ByteStrings each big enough to fill a 'bufferSize' buffer (16K).
22+wantData, otherData :: B.ByteString
23+wantData = B.replicate bufferSize 0xac
24+otherData = B.replicate bufferSize 0x77
25+
26+spec :: Spec
27+spec = describe "withBufferPool" $ do
28+ it "does not clobber buffers" $ do
29+ pool <- newBufferPool
30+ -- 'pool' contains B.empty; prime it to contain a real buffer.
31+ _ <- withBufferPool pool $ const $ return 0
32+ -- 'pool' contains a 16K buffer; fill it with \xac and keep the result.
33+ got <- withBufferPool pool $ blitBuffer wantData
34+ got `shouldBe` wantData
35+ -- 'pool' should now be empty and reallocate, rather than clobber the
36+ -- previous buffer.
37+ _ <- withBufferPool pool $ blitBuffer otherData
38+ got `shouldBe` wantData
39+
40+-- Fill the Buffer with the contents of the ByteString and return the number of
41+-- bytes written. To be used with 'withBufferPool'.
42+blitBuffer :: B.ByteString -> (Buffer, BufSize) -> IO Int
43+blitBuffer (B.PS fp off len) (dst, len') = withForeignPtr fp $ \ptr -> do
44+ let src = ptr `plusPtr` off
45+ n = min len len'
46+ copyBytes dst src n
47+ return n