test.lisp

   1 (require 'netclos)
   2
   3 (in-package nc)
   4
   5 (trace ensure-os make-server-stream initialize-tcp-server-process)
   6
   7 (ensure-os)
   8
   9
  10 (defclass move-tester (ncl-object)
  11   ((s1 :accessor s1
  12        :initarg :s1
  13        :moving-behavior :stay)
  14    (s2 :accessor s2
  15        :initarg :s2
  16        :moving-behavior :stay)
  17    (s3 :accessor s3
  18        :initarg :s3
  19        :moving-behavior :follow))
  20   (:metaclass mobile-object-class))
  21
  22 (defpargeneric pg1 :future (tester))
  23
  24 (defmethod pg1 ((tester move-tester)) (s1 tester))
  25
  26 (defpargeneric pg2 :past (tester val))
  27
  28 (defmethod pg2 ((tester move-tester) val) (setf (s1 tester) val))
  29
  30 (defclass move-part ()
  31   ((s1 :accessor s1
  32        :initarg :s1
  33        :moving-behavior :stay))
  34   (:metaclass  mobile-object-class))
  35
  36 (defun testos (&rest machines)
  37   (ensure-os)
  38   (when machines
  39     (start-virtual-machine  machines))
  40   (let ((proxy1 (move (make-instance 'move-tester
  41                         :s1 1
  42                         :s2 (make-instance 'move-tester)
  43                         :s3 (make-instance 'move-part))
  44                       (first (spaces *manager*)))))
  45     (setf *test* proxy1)))
  46
  47 (defgeneric remfoo (tester1 tester2)
  48   (:generic-function-class ncl-gf))
  49
  50 (defmethod remfoo ((t1 move-tester) (t2 move-tester))
  51   (let ((help (s1 t1)))
  52     (setf (s1 t1) (s1 t2))
  53     (setf (s1 t2) help)))
  54
  55
  56 (trace ensure-os make-server-stream)
  57
  58 (ensure-os)
  59
  60 ;; (defpsystem :test (:default-pathname "nclos:")
  61 ;;   (:definitions :actors
  62 ;;       (:serial "test")))
  63
  64 (defpsystem :test
  65     :serial t)
  66
  67 (compile-psystem :test)
  68
  69 (load-psystem :test)
  70 (trace add-method proxy-test-lambda)