[GHC] #12079: seg fault while using gtk

[GHC]

#12079: seg fault while using gtk
--------------------------------------+----------------------------------
           Reporter:  doofin          |             Owner:
               Type:  bug             |            Status:  new
           Priority:  normal          |         Milestone:
          Component:  Compiler        |           Version:  7.10.3
           Keywords:                  |  Operating System:  Linux
       Architecture:  x86_64 (amd64)  |   Type of failure:  Runtime crash
          Test Case:                  |        Blocked By:
           Blocking:                  |   Related Tickets:
Differential Rev(s):                  |         Wiki Page:
--------------------------------------+----------------------------------
 {{{#!hs
 {-# LANGUAGE OverloadedStrings #-}

 module Main where
 import Graphics.UI.Gtk
 import System.Glib.Signals
 import Graphics.UI.Gtk.SourceView
 import Graphics.UI.Gtk.SourceView.SourceGutter
 import Graphics.UI.Gtk.SourceView.SourceCompletion
 import Graphics.UI.Gtk.SourceView.SourceMark
 import Graphics.UI.Gtk.SourceView.SourceBuffer
 import Graphics.UI.Gtk.Multiline.TextBuffer
 import Graphics.UI.Gtk.Gdk.EventM
 import Control.Monad.Trans
 import System.FSNotify
 import System.Environment
 import Control.Concurrent (threadDelay)
 import Control.Monad (forever)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Tuple
 import Data.Tuple.HT
 import Control.Concurrent

 main=do
   args<-getArgs
   print args
   let filename=head args
   txt<-T.readFile filename
   gtk txt $ \srcbf->do
     notify $ \evt -> case evt of
       Modified fp _->if (T.unpack $ Prelude.last $ T.splitOn "/" $ T.pack
 fp)==filename
                      then do
                        txtnew<-T.readFile $ head args
                        postGUIAsync $ textBufferSetText srcbf
 (txtnew::T.Text)
                      else return ()
       _->return ()
   return ()

 notify action=withManager $ \mgr-> do
   --mgr<-startManager
   watchTree
       mgr          -- manager
       "."          -- directory to watch
       (const True) -- predicate
       $ \evt->do
           print evt-- action
           action evt
   forever $ threadDelay 1000000 -- sleep forever (until interrupted)

 gtk inittext act= do
   initGUI
   window <- windowNew
   windowSetDefaultSize window 900 600
   windowSetPosition window WinPosCenter

   srcbf<-sourceBufferNew Nothing
   sourceView <- sourceViewNewWithBuffer srcbf
   scrolledWindow <- scrolledWindowNew Nothing Nothing

   sourceViewSetShowLineNumbers sourceView True
   textViewSetWrapMode sourceView WrapWord
   textBufferInsertAtCursor srcbf ("fdsf"::String)
   textBufferSetText srcbf inittext

   scrolledWindow `containerAdd` sourceView
   window `containerAdd` scrolledWindow
   widgetShowAll window

   on sourceView keyPressEvent  $ do
     kl<-eventKeyName
     liftIO $ putStr $ show $ kl
     liftIO $ mapM_ (\(x,y)->if x==kl then textBufferInsertAtCursor srcbf
 (y::String) else return ()) pairs
     return False
   on window deleteEvent $ liftIO mainQuit >> return False
   connectGeneric "notify::cursor-position" False srcbf $ do
     print "adsfd"

   forkIO $ do
     act srcbf

   --onDestroy window  mainQuit


   mainGUI


 pairs=[("parenleft",")"),("[","]")]

 }}}

 the program runs ok before adding the line

 {{{#!hs
 connectGeneric "notify::cursor-position" False srcbf $ do
     print "adsfd"
 }}}


 then i run
   ghc thisfile.hs -debug
   gdb thisfile
   run somefile

 move the cursor inside the textview,then seg fault happened


   bt


 {{{
 result:

 Program received signal SIGSEGV, Segmentation fault.
 0x00007fffeea0f4f0 in ?? ()
 (gdb) bt
 #0  0x00007fffeea0f4f0 in ?? ()
 #1  0x00000000000002f5 in ?? ()
 #2  0x0000000000000309 in ?? ()
 #3  0x00007fffffff44f8 in ?? ()
 #4  0x00007fffffff4458 in ?? ()
 #5  0x00007fff04fe0101 in ?? ()
 #6  0x0000000000000113 in ?? ()
 #7  0x00000000000002e5 in ?? ()
 #8  0x0000000001db00ac in ?? ()
 #9  0x00007fffeea13a21 in ?? ()
 #10 0x00007fffeeaf5010 in ?? ()
 #11 0x0000000000a8d709 in base_GHCziIOziFD_zdfBufferedIOFD2_closure ()
 #12 0x00007fffeea07942 in ?? ()
 #13 0x0000000000a8593a in base_GHCziIOziBuffer_WriteBuffer_closure ()
 #14 0x0000000000000800 in ?? ()
 #15 0x0000000000000000 in ?? ()

 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/12079>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler