Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Test and fix for QWebView construction: When caching superclass point…

…ers, be careful around cross-module casts
  • Loading branch information...
commit 814ec9f9aaa8bb4db5b7b4341d375a61787156ad 1 parent 7cede72
lichtblau lichtblau authored David Lichteblau committed
8 call.lisp
@@ -418,3 +418,11 @@
418 418 (funcall fun c)
419 419 (map-qclass-superclasses #'recurse c)))
420 420 (recurse class)))
  421 +
  422 +(defun map-cpl-using-result (fun class initial-value)
  423 + (labels ((recurse (c val)
  424 + (let ((newval (funcall fun c val)))
  425 + (map-qclass-superclasses
  426 + (lambda (sub) (recurse sub newval))
  427 + c))))
  428 + (recurse class initial-value)))
2  marshal.lisp
@@ -35,6 +35,8 @@
35 35 (if (eql module (ldb-module <to>))
36 36 <to>
37 37 (find-qclass-in-module module (qclass-name <to>)))))
  38 + (unless compatible-<to>
  39 + (error "sorry, casting across modules in several steps not yet supported"))
38 40 (values (data-castfn (data-ref module))
39 41 compatible-<to>)))
40 42
13 meta.lisp
@@ -104,10 +104,15 @@
104 104 (let ((ptr (qobject-pointer object)))
105 105 ; (assert (null (pointer->cached-object ptr)))
106 106 (setf (pointer->cached-object ptr) object)
107   - (map-cpl (lambda (super)
108   - (setf (pointer->cached-object (%cast object super))
109   - object))
110   - (qobject-class object))
  107 + (assert (qobject-class object))
  108 + (map-cpl-using-result (lambda (super casted)
  109 + (let ((ptr (%cast casted super)))
  110 + (setf (pointer->cached-object ptr) object)
  111 + (make-instance 'qobject
  112 + :class super
  113 + :pointer ptr)))
  114 + (qobject-class object)
  115 + object)
111 116 (when (typep object 'dynamic-object)
112 117 (setf (gethash (cffi:pointer-address ptr) *strongly-cached-objects*)
113 118 object)))
7 test/tests.lisp
@@ -377,3 +377,10 @@
377 377 (assert (equal (#_objectName instance) "dummy")))
378 378 t)))
379 379 t)
  380 +
  381 +(deftest/qt new-qwebview
  382 + (progn
  383 + (ensure-smoke :qtwebkit)
  384 + (with-object (x (#_new QWebView)))
  385 + t)
  386 + t)

0 comments on commit 814ec9f

Please sign in to comment.
Something went wrong with that request. Please try again.