Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
;;; -*- 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
))
|#