fin crash

(cl:defpackage :funcall-instance-test
  (:use #:cl))

(cl:in-package #:funcall-instance-test)

(defclass my-funcallable-instance ()
  ((name :initarg :name :initform nil :accessor fin-name)
   (function :initarg :function :initform nil :accessor fin-function))
  (:metaclass sb-mop:funcallable-standard-class))


(defmethod initialize-instance :after ((fin my-funcallable-instance) &rest initargs)
  (declare (ignore initargs))
  (when (fin-function fin)
    (sb-mop:set-funcallable-instance-function fin (fin-function fin))))


;;; djula stuff

(asdf:load-system 'djula)

(defparameter *template-string* "{% block title %}Welcome to Caveman2{% endblock %}
{% block content %}
<div id=\"main\">
bogus
</div>
{% endblock %}")

(defparameter *fins*
  (make-hash-table :test 'equal))

(defparameter *cb1*
  (sb-alien::alien-callback
   (function sb-alien::unsigned-int)
   (lambda ()
     (setf (gethash "f2" *fins*)
           (make-instance 'my-funcallable-instance
                          :name "f2"
                          :function (let ((*default-pathname-defaults* #p"~/projects/tumak/"))
                                      (djula::compile-string *template-string*))))
     42)))

;; run the stuff down here a few times

(sb-alien:alien-funcall *cb1*)

(sb-ext:gc :full t)

(maphash (lambda (k v) (print (cons k v))) *fins*)

(cl:defpackage :funcall-instance-test
  (:use #:cl))

(cl:in-package #:funcall-instance-test)

(defclass my-funcallable-instance ()
  ((name :initarg :name :initform nil :accessor fin-name)
   (function :initarg :function :initform nil :accessor fin-function))
  (:metaclass sb-mop:funcallable-standard-class))

(defmethod initialize-instance :after ((fin my-funcallable-instance) &rest initargs)
  (declare (ignore initargs))
  (when (fin-function fin)
    (sb-mop:set-funcallable-instance-function fin (fin-function fin))))

(defparameter *fins*
  (make-hash-table :test 'equal))

(setf (gethash "f1" *fins*) "bogus")

(sb-ext:gc :full t)

(setf (gethash "f1" *fins*)
      (make-instance 'my-funcallable-instance
                     :name "f1"
                     :function (lambda () "This is some text!")))
(sb-ext:gc :full t)

(maphash (lambda (k v) (print (cons k v))) *fins*)

Greatly reduced test case above.

(defclass fin ()
  ()
  (:metaclass sb-mop:funcallable-standard-class))

(let ((hash (make-hash-table)))
  (loop repeat 100 do
        (setf (gethash 1 hash)
              (make-instance 'fin))
        (sb-ext:gc :full t)
        (print (gethash 1 hash))))