; Copyright 2005-2007 Kevin Reid, under the terms of the MIT X license
; found at http://www.opensource.org/licenses/mit-license.html ................

(defpackage :e.lisp-test.turn
  (:use :cl :e.lisp-test :e.elib :e.util))
(cl:in-package :e.lisp-test.turn)


(deftest vat-label.init
  (label (make-instance 'vat :label "aardvarks" :runner (make-runner-for-this-thread)))
  "aardvarks")

(deftest vat-label.establish-vat
  (prog2
    (establish-vat :label "initiative")
    (label *vat*)
    (setf *vat* nil *runner* nil))
  "initiative")

(deftest vat-label.with-vat
  (block nil
    (with-vat (:label "potato")
      (return (label *vat*))))
  "potato")


(defun stream-handler-target (stream &key strict)
  ;; XXX this belongs in e.util with the rest of the serve-event layer
  #+sbcl
    (etypecase stream
      (synonym-stream
        (if strict
          (error "can't strictly make a target from synonym stream ~S" stream)
          (stream-handler-target (symbol-value (synonym-stream-symbol stream)))))
      (sb-sys:fd-stream (sb-sys:fd-stream-fd stream)))
  #-sbcl stream)

#-(and) ;; XXX disabled because it leaks fds. also, the entire io-handler  mechanism has been changed, so...
(deftest exclusive-io-handler-pound
  (let* ((*runner* (make-runner-for-this-thread))
         (vat (make-instance 'vat :label "exclusive-io-handler-pound test"))
         (*vat* vat)
         (seen 0)
         (streams
           (loop for i below 20 collect
             (external-process-output-stream (run-program "/bin/sh" (list "-c" (format nil "sleep 1; echo ~S" i)) :output :stream :wait nil))))
         (handlers (mapcar
                     (lambda (s &aux handler)
                       (setf handler
                         (vr-add-io-handler
                           runner
                           (stream-handler-target s)
                           :input
                           (lambda (target)
                             (with-turn (vat)
                               (read s)
                               ;(warn "got ~S" ...)
                               (incf seen)
                               (vr-remove-io-handler handler))))))
                     streams)))
    (unwind-protect
      (block pound
        (labels ((task1 (i)
                   ;(warn "task1 ~A" i)
                   (when (>= seen (length streams))
                     (return-from pound))
                   (e<- (e.knot::wrap-function #'task1) |run| (1+ i))))
          (task1 0)
          (top-loop)))
      (map nil #'vr-remove-io-handler handlers))
    (values)))

(deftest ordinary-turn-excludes-io
  ;; Tests that turns created with E.ELIB:ENQUEUE-TURN do IO handler exclusion.
  ;; XXX this test makes little sense now that there isn't an exclusion layer
  (let* ((runner (make-runner-for-this-thread))
         (*runner* runner)
         (vat (make-instance 'vat :label "ordinary-turn-excludes-io test"
                                  :runner runner))
         (*vat* vat)
         (unseen 3)
         (handler (vr-add-io-handler runner
                    (stream-handler-target *standard-output* #|XXX assuming *standard-output* is always writable - bad assumption|#)
                    :output
                    (lambda (target)
                      (declare (ignore target))
                      (with-turn (vat)
                        #+(or) (warn "in io turn with ~S" unseen)
                        #| nothing |#)))))
    (unwind-protect
      (block done
        (loop repeat unseen do
          (enqueue-turn vat
            (lambda ()
              #+(or) (warn "in send turn with ~S" unseen)
              (#+sbcl sb-sys:serve-event
               #+cmu sys:serve-event
               #-(or sbcl cmucl) identity
                0.1) ;; allow the IO handler to possibly execute
              (decf unseen)
              (unless (plusp unseen)
                (return-from done)))))
        (top-loop))
      (vr-remove-io-handler handler))
    (values)))

(defclass wrong-vat-example (vat-checking) ())
(deftest wrong-vat-catch
  (let ((x (block nil
             (with-vat (:label "wrong-vat-catch a")
               (return (make-instance 'wrong-vat-example))))))
    (handler-case
      (block nil
        (with-vat (:label "wrong-vat-catch b")
          (return (e. x |__getAllegedType|))))
      (simple-error (c)
        (nth-value 0 (cl-ppcre:regex-replace-all "\\{.*?\\}" (princ-to-string c) "{.}")))))
  "#<E.LISP-TEST.TURN::WRONG-VAT-EXAMPLE {.}>, which belongs to vat #<E.ELIB:VAT \"wrong-vat-catch a\" {.}>, was called (:|__getAllegedType/0| NIL) from vat #<E.ELIB:VAT \"wrong-vat-catch b\" {.}>.")

;;; --- Running multiple vats ---

(deftest two-vats
  (let* ((*runner* (make-runner-for-this-thread))
         (vats (list (make-instance 'vat :runner *runner* :label "multivat-1")
                     (make-instance 'vat :runner *runner* :label "multivat-2")))
         (counter 0))
    (block nil
      (flet ((ding () (incf counter) (when (= counter 2) (return))))
        (dolist (vat vats)
          (with-turn (vat)
            (e<- (efun () (ding)) |run|)))
        (runner-loop *runner*))))
  nil)