;; object system tests
(if (not (boundp 'show))
  (defunq show (expr)
    (? " = | "expr " = " (eval expr) "\n")
    "|"
  )
)
(if (not (boundp 'T:number))
  (progn
    (load 'test-funcs)
))
(test exo)

(defclass Point Object ((x :initform 0) (y :initform 0)))
(defun Point-y (obj) (getn obj 'y))
(defun Point-x (obj) (getn obj 'x))
(setq p (make-instance Point))

(defmethod dist ((p Point))
  "The distance from origin"
  (+
    (** (get p 'x) 2)
    (** (get p 'y) 2))
)

(defmethod dist ((p Int)) p)
(defun intpart (x) (coerce x Int))
(add-method Real 'dist intpart)

(T (dist 3.5) 3)
(T (dist p) 0)
(put p 'x 1)
(put p 'y 1)
(T (dist p) 2)
(T (dist 3) 3)

(add-method Point 'dist (lambda (p)
    (+
      (** (get p 'x) 2)
      (** (get p 'y) 2))
))
(add-method Int 'dist (lambda (p) p))

(setq pl '(x 4 y 3 dist
    (lambda (p)
      (+
	(** (get p 'x) 2)
	(** (get p 'y) 2))
)))

(defclass Point3D Point ((z :initform 0)))

(defmethod init ((obj Point3D) &rest other-args)
  (setq Last-Point-Sum
    (+ (get obj 'x)(get obj 'y)(get obj 'z))
  )
  (setq Point3D:LastArgs other-args)
)
  
(defmethod free ((obj Point3D)) (setq Last-Point-Sum 42))

(defmethod dist ((p Point3D))
    (+ (call-next-method)
      (** (get p 'z) 2))
)

(setq p3 ()) ;; avoid side effect with freeing previously stored value
(setq p3 (make-instance Point3D 'x 1 'y 2 'z 3))
(T (dist p3) 14)
(T Point3D:LastArgs ())
(T Last-Point-Sum 6)
(setq p3 ())
(setq p3 (make-instance Point3D 'x 1 'y 2 'Z 4))
(T Point3D:LastArgs '(Z 4))
(T Last-Point-Sum 3)

(T (Point-x p3) 1)
(T (Point-y p3) 2)
(progn 
  (make-instance Point3D)
  ()			;forces GC
)
(T Last-Point-Sum 42)
(setq p3 (make-instance Point3D 'x 1 'y 2 'z 3))

(make-instance Point3D  'y 2)

(defmethod dist ((p Point3D))
  (call-next-method (make-instance Point 'x 3 'y 4))
)
(T (dist p3) 25)

(defmethod + ((p Point) q)
  (+ (get p 'x) (get q 'x) (get p 'y) (get q 'y))
)

(setq p (make-instance Point :x 1 :y 2))
(T (+ p p) 6)


(defclass dummy  () ())
(defclass dummy2  dummy ())
(setq x (make-instance dummy))
(setq x2 (make-instance dummy2))

(defun global-method (x) 'IAmFoo)

(add-method dummy 'display global-method)
(add-method dummy2 'display global-method)

(T (display x) 'IAmFoo)
(T (display x2) 'IAmFoo)

(defmethod display ((p dummy)) 'IAmRedefined)

(T (display x) 'IAmRedefined)
(T (display x2) 'IAmRedefined)

(defmethod print ((p Point) stream)
  (print-format stream "[%0, %1]" (get p 'x) (get p 'y))
)

(setq p (make-instance Point 'x 3 'y -4))
(T (progn (setq s (copy ""))
    (with (*standard-output* (open s :type :string :direction :output))
      (? p)
    )
    s
  )
  "[3, -4]"
)

;; obsolete pseudo-slots
;; (defclass Node () (&father-link sons data))
;; (defmethod father ((node Node) slot value must-set?)
;;   (if must-set?
;;     (put node '&father-link (link-set value))
;;     (link-get (getn node '&father-link))
;; ))
;; (setq anode (make-instance Node 'father Object))
;; 
;; (T (get anode 'father) Object)
;; (put anode 'father ())
;; (T (get anode 'father) ())
;; 
(defmethod dist ((s String)) (length s))

(defmethod dist ((s Atom)) (call-next-method))
(test exo_pseudo_slots)
(T (dist "foo") 3)
(T (dist 'dist) 4)

(T (apply 'dist (list p3)) 25)
(T (apply 'dist (list "foo")) 3)

(test exo_super)
(defclass Point4D Point3D ((a :initform 0)))
(defclass Point5D Point4D ((a :initform 0)))

(defmethod arity ((obj Point)) (setq x "a"))
(defmethod arity ((obj Point3D)) (call-next-method) (nconc x "b"))
(defmethod arity ((obj Point4D)) (call-next-method) (nconc x "c"))
(defmethod arity ((obj Point5D)) (call-next-method) (nconc x "d"))

(T (arity (make-instance Point5D)) "abcd")