diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +### 0.20.5 + ++ Run object finalizers in the main loop. The reason is that for +some types the destructor is not thread safe, and assumes that it +is being run from the same thread as the thread that created the object, +which can lead to crashes when using the threaded runtime. + ### 0.20.4 + Better error diagnostics for [wrapObject](https://hackage.haskell.org/package/haskell-gi-base/docs/Data-GI-Base-ManagedPtr.html#v:wrapObject) and [newObject](https://hackage.haskell.org/package/haskell-gi-base/docs/Data-GI-Base-ManagedPtr.html#v:newObject). diff --git a/Data/GI/Base/GError.hsc b/Data/GI/Base/GError.hsc --- a/Data/GI/Base/GError.hsc +++ b/Data/GI/Base/GError.hsc @@ -11,15 +11,15 @@ -- -- For convenience, generated code also includes specialized variants -- of 'catchGErrorJust' \/ 'handleGErrorJust' for each error type. For --- example, for errors of type 'GI.GdkPixbuf.Enums.PixbufError' one could --- invoke 'GI.GdkPixbuf.Enums.catchPixbufError' \/ --- 'GI.GdkPixbuf.Enums.handlePixbufError'. The definition is simply +-- example, for errors of type one could +-- invoke \/ +-- . The definition is simply -- -- > catchPixbufError :: IO a -> (PixbufError -> GErrorMessage -> IO a) -> IO a -- > catchPixbufError = catchGErrorJustDomain -- -- Notice that the type is suitably specialized, so only --- errors of type 'GI.GdkPixbuf.Enums.PixbufError' will be caught. +-- errors of type will be caught. module Data.GI.Base.GError ( -- * Unpacking GError @@ -149,7 +149,7 @@ -- class. This class helps to hide the raw error and domain codes from the -- user. -- --- Example for 'GI.GdkPixbuf.PixbufError': +-- Example for : -- -- > instance GErrorClass PixbufError where -- > gerrorClassDomain _ = "gdk-pixbuf-error-quark" diff --git a/Data/GI/Base/ManagedPtr.hs b/Data/GI/Base/ManagedPtr.hs --- a/Data/GI/Base/ManagedPtr.hs +++ b/Data/GI/Base/ManagedPtr.hs @@ -98,9 +98,7 @@ } -- | Do not run the finalizers upon garbage collection of the --- `ManagedPtr`, for the given reason. If later code tries to access --- the underlying pointer the given reason will be printed as part of --- the error message. +-- `ManagedPtr`. disownManagedPtr :: forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a) disownManagedPtr managed = do ptr <- unsafeManagedPtrGetPtr managed @@ -250,8 +248,10 @@ fPtr <- newManagedPtr' ptr_to_g_object_unref $ castPtr ptr return $! constructor fPtr - -foreign import ccall "dbg_g_object_unref" +-- It is fine to use unsafe here, since all this does is schedule an +-- idle callback. The scheduling itself will never block for a long +-- time, or call back into Haskell. +foreign import ccall unsafe "dbg_g_object_unref" dbg_g_object_unref :: Ptr a -> IO () -- | Decrease the reference count of the given 'GObject'. The memory @@ -273,7 +273,10 @@ dbg_g_object_disown ptr castPtr <$> disownManagedPtr obj -foreign import ccall "boxed_free_helper" boxed_free_helper :: +-- It is fine to use unsafe here, since all this does is schedule an +-- idle callback. The scheduling itself will never block for a long +-- time, or call back into Haskell. +foreign import ccall unsafe "boxed_free_helper" boxed_free_helper :: CGType -> Ptr a -> IO () foreign import ccall "g_boxed_copy" g_boxed_copy :: @@ -312,18 +315,18 @@ foreign import ccall "g_boxed_free" g_boxed_free :: CGType -> Ptr a -> IO () --- | Free the memory associated with a boxed object +-- | Free the memory associated with a boxed object. Note that this +-- disowns the associated `ManagedPtr` via `disownManagedPtr`. freeBoxed :: forall a. (HasCallStack, BoxedObject a) => a -> IO () freeBoxed boxed = do GType gtype <- boxedType (undefined :: a) - ptr <- unsafeManagedPtrGetPtr boxed + ptr <- disownManagedPtr boxed g_boxed_free gtype ptr - touchManagedPtr boxed -- | Disown a boxed object, that is, do not free the associated -- foreign GBoxed when the Haskell object gets garbage -- collected. Returns the pointer to the underlying `BoxedObject`. -disownBoxed :: BoxedObject a => a -> IO (Ptr a) +disownBoxed :: (HasCallStack, BoxedObject a) => a -> IO (Ptr a) disownBoxed = disownManagedPtr -- | Wrap a pointer, taking ownership of it. diff --git a/c/hsgclosure.c b/c/hsgclosure.c --- a/c/hsgclosure.c +++ b/c/hsgclosure.c @@ -6,6 +6,7 @@ #include #include +#include int check_object_type(void *instance, GType type) { @@ -32,27 +33,52 @@ return __print_debug_info; } -/* Auxiliary function for freeing boxed types */ -void boxed_free_helper (GType gtype, void *boxed) +/* Information about a boxed type to free */ +typedef struct { + GType gtype; + gpointer boxed; +} BoxedFreeInfo; + +/* Auxiliary function for freeing boxed types in the main loop. See + the annotation in g_object_unref_in_main_loop() below. */ +static gboolean main_loop_boxed_free_helper (gpointer _info) { + BoxedFreeInfo *info = (BoxedFreeInfo*)_info; + if (print_debug_info()) { - fprintf(stderr, "Freeing a boxed object at %p\n", boxed); - fprintf(stderr, "\tIt is of type %s\n", g_type_name(gtype)); + GThread *self = g_thread_self (); + + fprintf(stderr, "Freeing a boxed object at %p from idle callback [thread: %p]\n", + info->boxed, self); + fprintf(stderr, "\tIt is of type %s\n", g_type_name(info->gtype)); } - g_boxed_free (gtype, boxed); + g_boxed_free (info->gtype, info->boxed); if (print_debug_info()) { fprintf(stderr, "\tdone\n"); } + + g_free(info); } +void boxed_free_helper (GType gtype, void *boxed) +{ + BoxedFreeInfo *info = g_malloc(sizeof(BoxedFreeInfo)); + + info->gtype = gtype; + info->boxed = boxed; + + g_idle_add (main_loop_boxed_free_helper, info); +} + void dbg_g_object_disown (GObject *obj) { GType gtype; if (print_debug_info()) { - fprintf(stderr, "Disowning a GObject at %p\n", obj); + GThread *self = g_thread_self(); + fprintf(stderr, "Disowning a GObject at %p [thread: %p]\n", obj, self); gtype = G_TYPE_FROM_INSTANCE (obj); fprintf(stderr, "\tIt is of type %s\n", g_type_name(gtype)); fprintf(stderr, "\tIts refcount before disowning is %d\n", @@ -60,25 +86,45 @@ } } -void dbg_g_object_unref (GObject *obj) +static void print_object_dbg_info (GObject *obj) { + GThread *self = g_thread_self(); GType gtype; + fprintf(stderr, "Unref of %p from idle callback [thread: %p]\n", obj, self); + gtype = G_TYPE_FROM_INSTANCE (obj); + fprintf(stderr, "\tIt is of type %s\n", g_type_name(gtype)); + fprintf(stderr, "\tIts refcount before unref is %d\n", + (int)obj->ref_count); +} + +/* + We schedule all GObject deletions to happen in the main loop. The + reason is that for some types the destructor is not thread safe, and + assumes that it is being run from the same thread as the main loop + that created the object. + */ +static gboolean +g_object_unref_in_main_loop (gpointer obj) +{ if (print_debug_info()) { - fprintf(stderr, "Freeing a GObject at %p\n", obj); - gtype = G_TYPE_FROM_INSTANCE (obj); - fprintf(stderr, "\tIt is of type %s\n", g_type_name(gtype)); - fprintf(stderr, "\tIts refcount before unref is %d\n", - (int)obj->ref_count); + print_object_dbg_info ((GObject*)obj); } - g_object_unref(obj); + g_object_unref (obj); if (print_debug_info()) { - fprintf(stderr, "\tdone\n"); + fprintf(stderr, "\tUnref done\n"); } + + return FALSE; /* Do not invoke again */ } +void dbg_g_object_unref (GObject *obj) +{ + g_idle_add(g_object_unref_in_main_loop, obj); +} + /** * dbg_g_object_new: * @gtype: #GType for the object to construct. @@ -98,8 +144,10 @@ gpointer result; if (print_debug_info()) { - fprintf(stderr, "Creating a new GObject of type %s\n", - g_type_name(gtype)); + GThread *self = g_thread_self(); + + fprintf(stderr, "Creating a new GObject of type %s [thread: %p]\n", + g_type_name(gtype), self); } result = g_object_newv (gtype, n_params, params); diff --git a/haskell-gi-base.cabal b/haskell-gi-base.cabal --- a/haskell-gi-base.cabal +++ b/haskell-gi-base.cabal @@ -1,5 +1,5 @@ name: haskell-gi-base -version: 0.20.4 +version: 0.20.5 synopsis: Foundation for libraries generated by haskell-gi description: Foundation for libraries generated by haskell-gi homepage: https://github.com/haskell-gi/haskell-gi-base @@ -43,7 +43,7 @@ Data.GI.Base.Signals, Data.GI.Base.Utils - pkgconfig-depends: gobject-2.0 >= 2.32 + pkgconfig-depends: gobject-2.0 >= 2.32, glib-2.0 build-depends: base >= 4.7 && < 5, bytestring, containers,