Skip to content
test.lisp 1.86 KiB
Newer Older
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;; Trivial Testing

(in-package :philip-jose)

#|
(require :asdf) (pushnew "/home/fare/lib/lisp-systems/" asdf:*central-registry* :test (function equal)) (asdf:oos (quote asdf:load-op) :qultivator :verbose t) (in-package :philip-jose) (DBG :foo (simple-client (list 7 8) "localhost" 7))

(unless *server* (start-single-threaded-server :process-events nil))
(issue-worker-job '(:fake 0) :on-completion (lambda (&rest x) (DBG :fake x))) (task-test 4)

(defvar *keys* nil)
(setf *keys* (apply (function worker-step) :server "localhost" *keys*))
|#

(defun run-test (f &rest args)
  (catch :exit
    (let (x keys)
      (with-call/cc
        (DBG :test (apply f args))
        (setf x t))
      (loop until x do (task-step)))))

(defmacro xtest (&body body)
  `(run-test (with-call/cc (lambda () ,@body))))

(defun task-loop-1 (n)
  (DBG :tl1 n)
  (when (plusp n)
    (schedule-local-task
     #'(lambda () (task-loop-1 (1- n)))))
  nil)

(defun test-seq (n)
  (xtest
    (loop for i from 1 to n do
      (DBG :test-seq i (issue-sequential-job `(:fake ,i))))
    (DBG :test-seq-end)))

(defun test-para (n)
  (xtest
    (DBG :tpara)
    (with-parallel-jobs (i)
      (loop for i from 1 to n do
        (DBG :i i)
        (i `(:fake ,i) :on-completion (lambda (&rest x) (DBG :fake x))))
      (DBG :no-issue-left))
    (DBG :z)))

(defun test-timeout (x y)
  (xtest
    (with-local-timeout (x c)
      (sleep/cc y)
      (maybe-win-local-task-competition c 42))))

#|(defun spawn-workers ()
  (let ((num-workers (hash-table-count *registered-hosts*)))
    (loop for x being the hash-keys of *registered-hosts* doing
	  (shell-command (format nil "ssh ~a" x))
	  (|#

#|
(defun run-client (server)
  (loop for count from 0 do
        (multiple-value-bind (start-block num-blocks) (get-next-slice server)
        ;;---*** finish me
        ))
|#