1
0
Fork 0
tinmop/src/tests/program-events-tests.lisp

101 lines
3.8 KiB
Common Lisp

;; tinmop: a multiprotocol client
;; Copyright © cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :program-events-tests)
(defsuite program-events-suite (all-suite))
(defclass dummy-ask-user-string-events (program-events::ask-user-input-string-event) ())
(defmethod process-event ((object dummy-ask-user-string-events))
(simulate-user-input object))
(defun simulate-user-input (ask-event)
(let ((input-done-event (make-instance 'user-input-string-event
:payload (payload ask-event)
:lock
(program-events::lock ask-event)
:condition-variable
(program-events::condition-variable ask-event))))
(setf (dunbox (payload input-done-event)) "foo")
(push-event input-done-event)))
(defun dummy-ask-string-input (payload)
(let ((event (make-instance 'dummy-ask-user-string-events
:payload payload)))
(with-accessors ((lock program-events::lock)
(condition-variable program-events::condition-variable)) event
(push-event event)
(with-lock-held (lock)
(format t "wait!~%")
(condition-wait condition-variable lock)
(format t "input was ~a~%" (dunbox (payload event)))))))
(defun main-thread ()
(loop repeat 8 do
(sleep 1)
(if (event-available-p)
(progn
(format t "heap ~a~%" (pq::heap program-events::*events-queue*))
(process-event (pop-event)))
(format t "no event~%"))))
(defun simulated-string-input ()
(let ((payload (dbox "bar"))
(program-events::*events-queue* (make-instance 'events-queue))
(main-thread (make-thread #'main-thread)))
(sleep 3)
(make-thread (lambda ()
(dummy-ask-string-input payload)))
(join-thread main-thread)
payload))
(defclass dummy-window () ())
(defmethod (setf command-window:echo-character) (val (object dummy-window))
t)
(deftest test-ask-input (program-events-suite)
(setf specials:*command-window* (make-instance 'dummy-window))
(assert-true
(string= "foo" (dunbox (simulated-string-input)))))
(defun callback ()
"callback called!")
(defun callback-example ()
(flet ((callback () "callback called!"))
(client-events:start-events-loop)
(let ((res nil))
(make-thread (lambda ()
(sleep 3)
(format t "push!~%")
(setf res
(push-function-and-wait-results #'callback))
(format t "pop!~%")))
(map 'nil
(lambda (a)
(sleep 1)
(push-event-unblock (make-instance 'function-event
:payload (lambda () (format t "~a~%" a)))))
(loop for i from 0 to 10 collect i))
(client-events:stop-events-loop)
res)))
(deftest test-callback (program-events-suite)
(assert-equality #'string= "callback called!" (callback-example)))