test.lisp (3367 bytes)
1 ;;; Tests for DEFSL. Run them with (asdf:test-system :sl). 2 3 (defpackage #:sl-test.a (:use)) 4 (defpackage #:sl-test.b (:use)) 5 (defpackage #:sl-test.c (:use)) 6 7 (defpackage #:sl-test 8 (:use #:cl #:fiveam #:sl)) 9 (in-package #:sl-test) 10 11 (def-suite sl :description "DEFSL takes the first available definition.") 12 (in-suite sl) 13 14 ;;; Fixture forks. Each test decides which of them define GREET. 15 16 (defparameter *forks* '(sl-test.a sl-test.b sl-test.c) 17 "The fixture packages, in the order of preference that the tests use.") 18 19 (defun provide-greet (available) 20 "Define GREET in each AVAILABLE fork, and in no other fork." 21 (dolist (fork *forks*) 22 (let ((greet (intern "GREET" fork))) 23 (if (member fork available) 24 (setf (symbol-function greet) (constantly fork)) 25 (fmakunbound greet))))) 26 27 (test first-available-fork-wins 28 "For each subset of forks that define GREET, DEFSL takes the first one." 29 (dotimes (mask (expt 2 (length *forks*))) 30 (let ((available (loop for fork in *forks* 31 for bit from 0 32 when (logbitp bit mask) collect fork))) 33 (provide-greet available) 34 (fmakunbound 'greet) 35 (if available 36 (progn (defsl greet :fn :eq sl-test.a sl-test.b sl-test.c) 37 (is (eq (first available) (funcall 'greet)))) 38 (signals error 39 (defsl greet :fn :eq sl-test.a sl-test.b sl-test.c)))))) 40 41 (test missing-package-is-skipped 42 (provide-greet '(sl-test.b)) 43 (is (eq 'greet (defsl greet :fn :eq sl-test.no-such-fork sl-test.b))) 44 (is (eq 'sl-test.b (funcall 'greet)))) 45 46 (test qualified-names 47 "Each fork can use its own name. DEFSL interns no symbol to look one up." 48 (provide-greet '(sl-test.b)) 49 (defsl hello :fn sl-test.a salute sl-test.b greet) 50 (is (eq 'sl-test.b (funcall 'hello))) 51 (is (null (find-symbol "SALUTE" 'sl-test.a)))) 52 53 (test variables 54 (setf (symbol-value (intern "*MOTTO*" 'sl-test.b)) "fork b") 55 (defsl *motto* :sym :eq sl-test.a sl-test.b) 56 (is (equal "fork b" (symbol-value '*motto*)))) 57 58 (test malformed-spec 59 "A package without a symbol is an error when the macro expands." 60 (signals error (macroexpand '(defsl greet :fn sl-test.a greet sl-test.b)))) 61 62 ;;; Real forks. The test system loads both sides of each fork, except MICROS, 63 ;;; so the first preference wins. 64 65 (defsl operator-arglist :fn :eq slynk swank micros) 66 67 (test slime-forks 68 "Sly's SLYNK comes before SLIME's SWANK and Lem's MICROS." 69 (is (eq #'operator-arglist #'slynk:operator-arglist)) 70 (is (stringp (operator-arglist "car" "CL")))) 71 72 (defsl md5sum-string :fn :eq sb-md5 md5) 73 74 (test md5-forks 75 "SB-MD5 is SBCL's fork of MD5. Other implementations fall back to MD5." 76 (is (equalp #(144 1 80 152 60 210 79 176 214 150 63 125 40 225 127 114) 77 (md5sum-string "abc")))) 78 79 (defsl check (macro-function macro-function) eos is fiveam is) 80 81 (test fiveam-forks 82 "Eos is a fork of FiveAM. A list names the namespace of macros." 83 (is (eq (macro-function 'check) (macro-function 'eos:is)))) 84 85 (defsl gensymmer (macro-function macro-function) 86 cl-utilities with-unique-names 87 alexandria with-gensyms) 88 89 (test renamed-macro 90 "The alias exists at compile time, so this file can use it as a macro." 91 (is (eq (macro-function 'gensymmer) 92 (macro-function 'cl-utilities:with-unique-names))) 93 (is (symbolp (gensymmer (name) name))))