f88f78378f
- use upstream variant of remove-cur_term-usage.patch OBS-URL: https://build.opensuse.org/request/show/347110 OBS-URL: https://build.opensuse.org/package/show/devel:languages:haskell/ghc?expand=0&rev=196
83 lines
3.5 KiB
Diff
83 lines
3.5 KiB
Diff
From 96455041834b54f86482741d940a7941c53cd01e Mon Sep 17 00:00:00 2001
|
|
From: Judah Jacobson <judah.jacobson@gmail.com>
|
|
Date: Mon, 30 Nov 2015 23:28:27 -0800
|
|
Subject: [PATCH] Use set_curterm instead of peek/poking curterm directly.
|
|
|
|
This fixes the build of GHC on openSUSE, which builds ncurses in "threaded"
|
|
mode. (Threaded ncurses hides the cur_term global from use).
|
|
|
|
Patch originally by Scott Bahling <sbahling@suse.com>.
|
|
|
|
We also mark set_cuterm as an "unsafe" FFI call since this change may cause
|
|
it to be called more often.
|
|
---
|
|
libraries/terminfo/System/Console/Terminfo/Base.hs | 28 ++++++++++------------------
|
|
1 file changed, 10 insertions(+), 18 deletions(-)
|
|
|
|
diff --git a/libraries/terminfo/System/Console/Terminfo/Base.hs b/System/Console/Terminfo/Base.hs
|
|
index 1f60679..719bb65 100644
|
|
--- a/libraries/terminfo/System/Console/Terminfo/Base.hs
|
|
+++ b/libraries/terminfo/System/Console/Terminfo/Base.hs
|
|
@@ -63,8 +63,8 @@ import Data.Typeable
|
|
data TERMINAL
|
|
newtype Terminal = Terminal (ForeignPtr TERMINAL)
|
|
|
|
-foreign import ccall "&" cur_term :: Ptr (Ptr TERMINAL)
|
|
-foreign import ccall set_curterm :: Ptr TERMINAL -> IO (Ptr TERMINAL)
|
|
+-- Use "unsafe" to make set_curterm faster since it's called quite a bit.
|
|
+foreign import ccall unsafe set_curterm :: Ptr TERMINAL -> IO (Ptr TERMINAL)
|
|
foreign import ccall "&" del_curterm :: FunPtr (Ptr TERMINAL -> IO ())
|
|
|
|
foreign import ccall setupterm :: CString -> CInt -> Ptr CInt -> IO ()
|
|
@@ -73,19 +73,15 @@ foreign import ccall setupterm :: CString -> CInt -> Ptr CInt -> IO ()
|
|
--
|
|
-- Throws a 'SetupTermError' if the terminfo database could not be read.
|
|
setupTerm :: String -> IO Terminal
|
|
-setupTerm term = bracket (peek cur_term) (poke cur_term) $ \_ ->
|
|
+setupTerm term =
|
|
withCString term $ \c_term ->
|
|
with 0 $ \ret_ptr -> do
|
|
-- NOTE: I believe that for the way we use terminfo
|
|
-- (i.e. custom output function)
|
|
-- this parameter does not affect anything.
|
|
let stdOutput = 1
|
|
- {-- Force ncurses to return a new struct rather than
|
|
- a copy of the current one (which it would do if the
|
|
- terminal names are the same). This prevents problems
|
|
- when calling del_term on a struct shared by more than one
|
|
- Terminal. --}
|
|
- poke cur_term nullPtr
|
|
+ -- Save the previous terminal to be restored after calling setupterm.
|
|
+ old_term <- set_curterm nullPtr
|
|
-- Call setupterm and check the return value.
|
|
setupterm c_term stdOutput ret_ptr
|
|
ret <- peek ret_ptr
|
|
@@ -93,7 +89,7 @@ setupTerm term = bracket (peek cur_term) (poke cur_term) $ \_ ->
|
|
then throwIO $ SetupTermError
|
|
$ "Couldn't look up terminfo entry " ++ show term
|
|
else do
|
|
- cterm <- peek cur_term
|
|
+ cterm <- set_curterm old_term
|
|
fmap Terminal $ newForeignPtr del_curterm cterm
|
|
|
|
data SetupTermError = SetupTermError String
|
|
@@ -120,14 +116,10 @@ setupTermFromEnv = do
|
|
-- TODO: this isn't really thread-safe...
|
|
withCurTerm :: Terminal -> IO a -> IO a
|
|
withCurTerm (Terminal term) f = withForeignPtr term $ \cterm -> do
|
|
- old_term <- peek cur_term
|
|
- if old_term /= cterm
|
|
- then do
|
|
- _ <- set_curterm cterm
|
|
- x <- f
|
|
- _ <- set_curterm old_term
|
|
- return x
|
|
- else f
|
|
+ old_term <- set_curterm cterm
|
|
+ x <- f
|
|
+ set_curterm old_term
|
|
+ return x
|
|
|
|
|
|
----------------------
|