Yurii Rashkovskii's Blog

I’ve played with somewhat funny Io programming language.

Its key advantages are prototype object model, messages, pass by expression and simplicity.

As a (intermediate?) result of my toying with it I’ve developed Protonio, framework that currently consits of Protoext (language extensions) & Protospec (BDD spec tool).

Yes, I did it. I have developed near feature-complete spec tool like RSpec. It tooks few days and about 400 lines of code (without self tests). For comparison, RSpec code is more than 5 thousands of lines of code. But I may miss something.

Anyway it was funny. I’m going to continue my experiments.

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

I’m definitely a BDD maniac. Recently I’ve created a quick-n-dirty Common Lisp BDD primitives and today I’ve hacked BDD primitives for Erlang. Just like Lisp version, it still lacks lots of BDD stuff, but only expectations. Here you are bdd.erl:

 
-module(bdd).

%%
%% Exported Functions
%%
-export([should/5,should_not/5,equal/2,be/2,raise/2,match/2,run/1]).

%%
%% Expectations
%%
should(Matcher,Args,Expr,File,Line) ->
    case apply(?MODULE,Matcher,[Args,Expr]) of
        false -> exit({expectation_not_met,{File,Line,Expr,should,Matcher,Args}});
        _ -> ok
    end.    

should_not(Matcher,Args,Expr,File,Line) ->
    case apply(?MODULE,Matcher,[Args,Expr]) of
        true -> exit({expectation_not_met,{File,Line,Expr,should_not,Matcher,Args}});
        _ -> ok
    end.    

%%
%% Matchers
%%

equal(Args,Expr) ->
  case Expr of
      Args -> true;
      _ -> false
  end.          

be([H|T],Expr) ->
  be(H,Expr,T);

be(Predicate, Expr) ->
  be(Predicate,Expr, []).  

be(Predicate,Expr,Args) ->
  Pred = list_to_atom("is_" ++ atom_to_list(Predicate)),
  case (catch apply(Pred,[Expr] ++ Args)) of
      {'EXIT',_} -> 
          % is it a bif?
          D = (catch apply(erlang,Pred,[Expr] ++ Args)),
          case (catch apply(erlang,Pred,[Expr] ++ Args)) of
              {'EXIT',_} ->
                  % last idea
                  apply(erlang,Predicate,[Expr] ++ Args);
              Result -> Result
          end;             
      Result -> Result
  end.    

raise(Args, Expr) ->
   case Expr of
        {'EXIT',{Args,_}} -> true;
        {'EXIT',Args} -> true;          
        _ -> false
   end.           

match(Args, Expr) ->
   not raise({badmatch,Expr},(catch Args=Expr)).        

run([M|Modules]) ->
    run(M) ++ run(Modules);

run([]) ->
    [];

run(M) ->
    Context = get_from_module(attributes,M,context),
    io:format("~s~n",[Context]),
    Fun = fun(Spec) ->
        case Spec of
            module_info -> skipped; 
            setup -> skipped;
            teardown -> skipped;
            context_setup -> skipped;
            context_teardown -> skipped;
            _ ->
            (catch M:setup()),
            io:format(" - ~s",[atom_to_list(Spec)]),
            case (catch apply(M,Spec,[])) of
                {'EXIT',{expectation_not_met,Value}} -> io:format(" (FAILED)~n",[]), {Spec,failed,Value};
                {'EXIT',Value} -> io:format(" (ERROR)~n",[]), {Spec,error,Value};
                _ -> (catch M:teardown()), io:format("~n",[]),{Spec,ok}
            end    
         end
    end,
    (catch M:context_setup()),
    R =lists:filter(fun(TestResult) -> not (TestResult =:= skipped) end, lists:map(fun(Item) -> hd(tuple_to_list(Item)) end,lists:keymap(Fun,1,M:module_info(exports)))),
    (catch M:context_teardown()),
    R.

get_from_module(Kind,Module,Name) ->
    {value, {Name, Val}} = lists:keysearch(Name,1,Module:module_info(Kind)),
    Val.
 

and bdd.hrl:

 
-define(bdd(Expr,Expectation,Matcher,Args),
        apply(bdd,Expectation,[Matcher,Args,(catch Expr),?FILE,?LINE])).
 

Now you can check various expectations:

 
test() ->
  ?bdd(1,should,equal,1),
  ?bdd(1,should_not,equal,2),
  ?bdd(1,should,be,integer),
  ?bdd(1,should_not,be,list),
  ?bdd(1,should,be,['>',0]),
  ?bdd(1,should,be,['>=',1]),
  ?bdd(1=2,should,raise,{badmatch,2}),
  ?bdd(1=1,should_not,raise,{badmatch,2}),
  ?bdd({ok,1+2},should,match,{ok,3}),
  ?bdd({error,-1},should_not,match,{ok,3}),
  ?bdd(#state{},should,be,[record,state]).
 

and create contexts with specifications as modules:

 
-module(empty_list_spec).
-context("Empty list").
%%
%% Include files
%%

-include("bdd.hrl").

%%
%% Exported Functions
%%
-export([setup/0,'should have zero length'/0]).

setup() ->
    put(empty_list,[]).

%%
%% Specifications
%%

'should have zero length'() ->
    ?bdd(length(get(empty_list)),should,equal,0).

%%
%% Local Functions
%%

 

Now just run it:

> bdd:run(empty_list_spec)
% or
> bdd:run([empty_list_spec])
Empty list
 - should have zero length
[{'should have zero length',ok}]

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.