Yurii Rashkovskii's Blog

I’ve created a small umbrella project for BDD implementations I’m playing with (Common Lisp and Erlang by now).

I was using Erlang from time to time from 2000 or 2001. I’ve even done some commerical trading-related system in it. It’s definitely a good language for certain domains, and it has bright past and may be even brighter future. I was experimenting with some ideas in Erlang today, after long period of not using it and I should say that fairly speaking Erlang is far away from being a friendly language in terms of syntax.

What if Erlang could be considered a kind of “assembly” language for high-performance and distributed programming? What if we can use Lisp macro or Ruby metaprogramming capabilities to code generate Erlang? Taking in account the fact that Erlang code could be changed without a stop, why not generating source code on the fly and passing it to Erlang VM?

Ok, just as a nighty idea.

Few days ago I’ve hacked a simplistic BDD for Common Lisp. I’m still having fun improving it. Here you are an improved respond-to? that supports generics much better.

 
  (defun respond-to? (o method &rest args)
  (restart-case
      (handler-bind ((undefined-function #'(lambda (c)
                         (declare (ignore c))
                         (invoke-restart 'no)))
             (simple-error #'(lambda (c)
                       (declare (ignore c))
                       (invoke-restart 'no))))
    (let ((sf (symbol-function method))
          (cpl (sb-pcl::class-precedence-list (class-of o))))
      (typecase sf
        (standard-generic-function
         (find t 
           (mapcar #'(lambda (klass)
                   (not (null
                     (find-method sf '() 
                          (cons klass
                            (mapcar #'(lambda (c) (declare (ignore c)) t) args)) nil))))
               cpl)))
        (function t))))
    (no (&optional v)
      nil)))
 

Though for non-generic functions there seems to be no way to check if actually object “responds” to function without actually evaluating it.

Anyway, it’s quite funny!

Yesterday and today I’ve spent few hours playing with an idea of BDD for Common Lisp. What for? Well, lets say “just for fun”. I’ve developed quick-and-dirty implementation of few bits of BDD, in the way similar to RSpec

Here you are:

 
;; Utilities
(defmethod obj->string ((s string))
  s)

(defmethod obj->string ((s symbol))
  (string s))

(defun concat-symbol (&rest args)
  (intern (apply #'concatenate 'string 
         (mapcar #'string-upcase (mapcar #'obj->string args)))))

(defun respond-to? (o method &rest args)
  (restart-case
      (handler-bind ((undefined-function #'(lambda (c)
                         (declare (ignore c))
                         (invoke-restart 'no)))
             (simple-error #'(lambda (c)
                       (declare (ignore c))
                       (invoke-restart 'no))))
    (symbol-function method)
    t)
    (no (&optional v)
      nil)))

;; Conditions

(define-condition expectation-not-met ()
  ())

;; Expectations
(defclass expectation ()
  ((expr :initarg :expr :reader expression-of)
   (args :initarg :args :reader args-of)))

(defclass should (expectation)
  ())

(defgeneric fulfills? (expectation))

(defmethod fulfills? ((e should))
  (flet ((match (matcher-class args expr)
       (restart-case
           (handler-bind ((simple-error #'(lambda (c)
                        (declare (ignore c))
                        (invoke-restart 'fun))))
         (matches? (make-instance matcher-class :args args) expr))
         (fun (&optional v)
           (apply matcher-class (append (list (eval expr)) args))))))
    (with-slots (args expr) e
      (if (equal (car args) 'not)
      (not (match (cadr args) (cddr args) expr))
      (match (car args) (cdr args) expr)))))

;; Matchers

(defclass matcher ()
  ((args :initarg :args :reader args-of)))

(defclass be (matcher)
  ())

(defmethod initialize-instance :after ((matcher be) &rest initargs)
  (declare (ignore initargs))
  (with-slots (args) matcher
    (when (equal (car args) 'a)
      (pop args))))

(defgeneric matches? (matcher expr))

(defmethod matches? ((matcher be) expr)
  (with-slots (args) matcher
    (let* ((arguments (cdr args))
       (message-forms (mapcar #'(lambda (suffix)
                      (concat-symbol (car args) suffix)) '("" "p" "-p" "?"))))
      (when (equal (car arguments) 'of)
    (pop arguments)) ;; am I crazy?
      (dolist (form message-forms)
    (when (respond-to? expr form arguments)
      (return (eval `(,form ,expr ,@arguments))))))))

(defclass raise (matcher)
  ())

(defmethod matches? ((matcher raise) expr)
  (with-slots (args) matcher
    (restart-case
    (handler-bind ((t #'(lambda (c)
                  (declare (ignore c))
                  (if (equal (class-of c) (find-class (car args)))
                      (invoke-restart 'raises)
                      (invoke-restart 'donot)))))
      (eval `(progn
           (eval ,expr)))
      nil)
      (raises (&optional v) t)
      (donot (&optional v) nil))))

;; 
(defmacro => (form &rest specification)
  (let ((expectation-class (car specification))
    (args (cdr specification)))
    `(let* ((result ',form)
        (expectation (make-instance ',expectation-class
                      :expr result
                      :args ',args)))
       (unless (fulfills? expectation)
     (error (make-instance 'expectation-not-met)))
       result)))

;; Grouping
(defmacro define-with-spec-grouping (name)
  (let ((with-grouping (concat-symbol "with-" name ))
    (spec-groupings (concat-symbol "*spec-" name "s*"))
    (spec-grouping (concat-symbol "*spec-" name "*")))
    `(defmacro ,with-grouping (grouping-name &body body)
       `(progn
      (unless (and (boundp ',',spec-groupings) (listp ,',spec-groupings))
        (defvar ,',spec-groupings nil))
      (let* ((,',spec-groupings (cons ,grouping-name ,',spec-groupings))
         (,',spec-grouping (car ,',spec-groupings)))
        ,@body)))))

(define-with-spec-grouping context)
(define-with-spec-grouping aspect)

(defmacro specify (name &body body)
  `(let ((*spec-specification* ,name))
     ,@body))

It allows me to write constructs like:

 
 CL-USER> (=> (1+ 1) should = 2)
 2
 CL-USER> (=> (1+ 1) should not be zero)
 2
 CL-USER> (=> 0 should not be zero)
 ; Exception raised
 CL-USER> (=> (+ 2 2) should = 5)
 ; Exception raised
 CL-USER> (=> 1 should be a member of '(1 2 3))
 1
 CL-USER> (=> 0 should be a member of '(1 2 3))
 ; Exception raised
 CL-USER> (=> (=> 1 should = 0) should raise expectation-not-met)
 (=> 1 SHOULD = 0)
 CL-USER> (=> (=> 1 should = 1) should not raise expectation-not-met)
 (=> 1 SHOULD = 1) 
 CL-USER> (=> (=> 1 should = 1) should raise expectation-not-met)
 ; Exception raised

and play with contexts, aspects and specifications.

It was funny.

It’s definitely what I was missing from Common Lisp:

• brilliant with method by Ola Bini