0.pre7.14:
[sbcl.git] / tests / clos.impure.lisp
1 ;;;; miscellaneous side-effectful tests of CLOS
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
8 ;;;; from CMU CL.
9 ;;;; 
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
13
14 (defpackage "FOO"
15   (:use "CL"))
16 (in-package "FOO")
17 \f
18 ;;;; It should be possible to do DEFGENERIC and DEFMETHOD referring to
19 ;;;; structure types defined earlier in the file.
20 (defstruct struct-a x y)
21 (defstruct struct-b x y z)
22 (defmethod wiggle ((a struct-a))
23   (+ (struct-a-x a)
24      (struct-a-y a)))
25 (defgeneric jiggle ((arg t)))
26 (defmethod jiggle ((a struct-a))
27   (- (struct-a-x a)
28      (struct-a-y a)))
29 (defmethod jiggle ((b struct-b))
30   (- (struct-b-x b)
31      (struct-b-y b)
32      (struct-b-z b)))
33 (assert (= (wiggle (make-struct-a :x 6 :y 5))
34            (jiggle (make-struct-b :x 19 :y 6 :z 2))))
35
36 ;;; Compiling DEFGENERIC should prevent "undefined function" style warnings
37 ;;; from code within the same file.
38 (defgeneric gf-defined-in-this-file ((x number) (y number)))
39 (defun function-using-gf-defined-in-this-file (x y n)
40   (unless (minusp n)
41     (gf-defined-in-this-file x y)))
42
43 ;;; Until Martin Atzmueller ported Pierre Mai's CMU CL fixes in
44 ;;; sbcl-0.6.12.25, the implementation of NO-APPLICABLE-METHOD was
45 ;;; broken in such a way that the code here would signal an error.
46 (defgeneric zut-n-a-m (a b c))
47 (defmethod no-applicable-method ((zut-n-a-m (eql #'zut-n-a-m)) &rest args)
48   (format t "~&No applicable method for ZUT-N-A-M ~S, yet.~%" args))
49 (zut-n-a-m 1 2 3)
50 \f
51 ;;;; success
52
53 (sb-ext:quit :unix-status 104)