diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2020-04-19 11:27:49 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-12-27 11:24:26 -0500 |
| commit | 4a25e85a47a9b52f3b311bc614c402a892a29f68 (patch) | |
| tree | 909e4576722d3838e7a1710a60d1e2920dcfffcc | |
| parent | 63199ad3f304e8046c4ef1c4890102e8acb959a3 (diff) | |
| download | haskell-4a25e85a47a9b52f3b311bc614c402a892a29f68.tar.gz | |
base: Use keepAlive# in withForeignPtr
(cherry picked from commit 33a6b81e41775798ddf65680f10a6dcd4c07b911)
| -rw-r--r-- | libraries/base/GHC/ForeignPtr.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T16012.script | 2 | ||||
| -rw-r--r-- | testsuite/tests/ghci/should_run/T16012.stdout | 2 |
3 files changed, 5 insertions, 3 deletions
diff --git a/libraries/base/GHC/ForeignPtr.hs b/libraries/base/GHC/ForeignPtr.hs index 9482cc46b5..c79bc7c172 100644 --- a/libraries/base/GHC/ForeignPtr.hs +++ b/libraries/base/GHC/ForeignPtr.hs @@ -527,7 +527,9 @@ withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- or from the object pointed to by the -- 'ForeignPtr', using the operations from the -- 'Storable' class. -withForeignPtr = unsafeWithForeignPtr +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> keepAlive# r s action# -- | This is similar to 'withForeignPtr' but comes with an important caveat: -- the user must guarantee that the continuation does not diverge (e.g. loop or diff --git a/testsuite/tests/ghci/should_run/T16012.script b/testsuite/tests/ghci/should_run/T16012.script index ab8b2d0ee0..2394e9c0ec 100644 --- a/testsuite/tests/ghci/should_run/T16012.script +++ b/testsuite/tests/ghci/should_run/T16012.script @@ -3,4 +3,4 @@ -- should always return a reasonably low result. n <- System.Mem.getAllocationCounter -if (n < 0 && n >= -160000) then putStrLn "Alloction counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) +if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n) diff --git a/testsuite/tests/ghci/should_run/T16012.stdout b/testsuite/tests/ghci/should_run/T16012.stdout index 2eb23fdb4c..0951b0f82b 100644 --- a/testsuite/tests/ghci/should_run/T16012.stdout +++ b/testsuite/tests/ghci/should_run/T16012.stdout @@ -1 +1 @@ -Alloction counter in expected range +Allocation counter in expected range |