Fixed GError GC-cleanup.

diff --git a/src/gtk/gio.scm b/src/gtk/gio.scm
index 2bb59658d8e1c246114cb85bb2bb8616d81720a3..b54ef5229bcf98a5321cf5b72635cb797ff59d94 100644 (file)
--- a/src/gtk/gio.scm
+++ b/src/gtk/gio.scm
@@ -211,13 +211,21 @@ USA.
    (named-lambda (g-input-stream-read-finish-callback source result)
      (let ((bytes (C-call "g_input_stream_read_finish" source result gerror*)))
        (if (fix:= bytes -1)
-          (let ((message (gerror->message gerror*)))
+          (let ((message (gerror-message gerror*)))
             (%trace ";g-input-stream-read-finish-callback "message" "queue"\n")
             (%queue! queue message))
           (begin
             (%trace ";g-input-stream-read-finish-callback "bytes" "queue"\n")
             (%queue! queue bytes)))))))
 
+(define-integrable (gerror-message pointer)
+  (let* ((GError (C-> pointer "* GError"))
+        (message (or (and (not (alien-null? GError))
+                          (c-peek-cstring (C-> GError "GError message")))
+                     "GError pointer not set.")))
+    (C->= pointer "* GError" 0)
+    message))
+
 (define-integrable (%queue! queue value)
   ;; The GIO finish callbacks use this procedure to queue a value on a
   ;; g-stream's queue AND signal the main loop if Scheme has become
@@ -254,7 +262,7 @@ USA.
    (named-lambda (g-input-stream-skip-finish-callback source result)
      (let ((bytes (C-call "g_input_stream_skip_finish" source result gerror*)))
        (if (fix:= bytes -1)
-          (let ((message (gerror->message gerror*)))
+          (let ((message (gerror-message gerror*)))
             (%trace ";g-input-stream-skip-finish-callback "message" "queue"\n")
             (%queue! queue message))
           (begin
@@ -299,7 +307,7 @@ USA.
    (named-lambda (g-input-stream-close-finish-callback source result)
      (if (fix:zero?
          (C-call "g_input_stream_close_finish" source result gerror*))
-        (let ((message (gerror->message gerror*)))
+        (let ((message (gerror-message gerror*)))
           (%trace ";g-input-stream-close-finish-callback "message" "queue"\n")
           (%queue! queue message))
         (begin
@@ -383,7 +391,7 @@ USA.
      (let ((bytes
            (C-call "g_output_stream_write_finish" source result gerror*)))
        (if (fix:= bytes -1)
-          (let ((message (gerror->message gerror*)))
+          (let ((message (gerror-message gerror*)))
             (%trace ";g-output-stream-write-finish-callback "message
                     " "queue"\n")
             (%queue! queue message))
@@ -419,7 +427,7 @@ USA.
    (named-lambda (g-output-stream-flush-finish-callback source result)
      (if (fix:zero?
          (C-call "g_output_stream_flush_finish" source result gerror*))
-        (let ((message (gerror->message gerror*)))
+        (let ((message (gerror-message gerror*)))
           (%trace ";g-output-stream-flush-finish-callback "message" "queue"\n")
           (%queue! queue message))
         (begin
@@ -465,7 +473,7 @@ USA.
    (named-lambda (g-output-stream-close-finish-callback source result)
      (if (fix:zero?
          (C-call "g_output_stream_close_finish" source result gerror*))
-        (let ((message (gerror->message gerror*)))
+        (let ((message (gerror-message gerror*)))
           (%trace ";g-output-stream-close-finish-callback "message" "queue"\n")
           (%queue! queue message))
         (begin
@@ -521,7 +529,7 @@ USA.
    (named-lambda (gfile-read-finish-callback source result)
      (let ((bytes (C-call "g_file_read_finish" alien source result gerror*)))
        (if (fix:= bytes -1)
-          (let ((message (gerror->message gerror*)))
+          (let ((message (gerror-message gerror*)))
             (%trace ";g-file-read-finish-callback \""message"\" "queue"\n")
             (%queue! queue message))
           (begin
@@ -639,7 +647,7 @@ USA.
 
 (define-integrable (g-output-stream-finish alien queue gerror* op)
   (if (alien-null? alien)
-      (let ((message (gerror->message gerror*)))
+      (let ((message (gerror-message gerror*)))
        (%trace ";g-output-stream-"op"-callback "message" "queue"\n")
        (%queue! queue message))
       (begin

diff --git a/src/gtk/gtk.pkg b/src/gtk/gtk.pkg
index 4b617433cb03eaadbd820ebde9111a4b8b27540e..2aeb837f0bb7b1dfdbafbbd2c673d0e8a9ab4fe5 100644 (file)
--- a/src/gtk/gtk.pkg
+++ b/src/gtk/gtk.pkg
@@ -44,7 +44,6 @@ USA.
          add-gc-cleanup punt-gc-cleanup
          gobject-get-property gobject-set-properties
          gquark-from-string gquark-to-string
-         gerror->message
          <pixbuf-loader> make-pixbuf-loader
          load-pixbuf-from-port load-pixbuf-from-file
          pixbuf-loader-size-hook set-pixbuf-loader-size-hook!