clucumber 0.1.0

data/LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2009 Andreas Fuchs
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

data/README.rdoc

@@ -0,0 +1,54 @@
+Clucumber, the CL Cucumber adapter
+==================================
+
+This is a (somewhat complete) implementation of the [cucumber wire
+protocol](http://wiki.github.com/aslakhellesoy/cucumber/wire-protocol) in (as portable as possible) Common Lisp. This means you can
+write [cucumber](http://cukes.info/) features, and write lisp code to execute
+your steps.
+
+Getting started
+---------------
+
+First, you write your cucumber features like you would any other.
+
+Then you define cucumber steps in CL: Just place them in
+features/step_definitions/*.lisp.
+
+If your application needs any support code, place that in
+support/*.lisp.
+
+Files in support and step_definitions/ are loaded (not file-compiled)
+in alphabetical order, with support/ files being loaded before step
+definitions.
+
+Running tests
+-------------
+
+In your `features/support/env.rb`, you load the clucumber.rb included in this distribution. Then, you run something like this:
+
+	begin
+	  @main_clucumber = ClucumberSubprocess.new(File.expand_path("../", File.dirname(__FILE__)),
+	                                           :port => 42428)
+	  at_exit do
+	    @main_clucumber.kill
+	  end
+
+	  @main_clucumber.start <<-LISP
+		;; Put code here that loads your application.
+	  LISP
+	rescue PTY::ChildExited
+	  puts(@main_clucumber && @main_clucumber.output)
+	end
+
+This will launch a lisp with clucumber loaded (pass :lisp parameter to `ClucumberSubprocess.new` to specify which lisp, it defaults to sbcl), and start listening on port 42428.
+
+Then, on the command line, you run cucumber:
+
+        $ cucumber
+
+And you watch the lines zip by.
+
+That should be all (-:
+
+Over the next few days, I hope to fill out the test suite with more
+interesting examples that you can use as a reference.

data/lib/clucumber/clucumber.asd

@@ -0,0 +1,5 @@
+(asdf:defsystem clucumber
+  :depends-on (:cl-interpol :cl-ppcre :trivial-backtrace :usocket :st-json)
+  :serial t
+  :components ((:file "packages")
+               (:file "server")))

data/lib/clucumber/packages.lisp

@@ -0,0 +1,17 @@
+(cl:defpackage #:clucumber-external
+  (:export #:start))
+
+(cl:defpackage #:clucumber-steps
+  (:export #:define-test-package #:*test-package*
+           #:Given* #:When* #:Then*
+           #:Before #:After
+           #:pending #:fail
+           #:var)
+  (:use #:cl #:cl-interpol))
+
+(cl:defpackage #:clucumber-user
+  (:export)
+  (:use #:cl #:clucumber-steps))
+
+(cl:defpackage #:clucumber
+  (:use #:cl #:clucumber-steps #:clucumber-external #:usocket #:st-json))

data/lib/clucumber/server.lisp

@@ -0,0 +1,242 @@
+(cl:in-package #:clucumber)
+
+(defvar clucumber-steps:*test-package* (find-package :clucumber-user))
+
+(defvar *print-backtraces* t)
+
+(defvar *base-pathname*)
+
+(defparameter *default-step-regex-delimiter* #\{)
+
+(defparameter *default-step-regex-close-delimiter* #\})
+
+(defun load-definitions (base-pathname)
+  (let ((support-files (directory (merge-pathnames (make-pathname :directory '(:relative "support"
+                                                                               :wild-inferiors)
+                                                                  :name :wild
+                                                                  :type "lisp")
+                                                   base-pathname)))
+        (step-files (directory (merge-pathnames (make-pathname :directory '(:relative "step_definitions"
+                                                                            :wild-inferiors)
+                                                               :name :wild
+                                                               :type "lisp")
+                                                base-pathname))))
+    (dolist (files (list support-files step-files))
+      (let ((*readtable* (copy-readtable))
+            (*package* *test-package*)
+            (cl-interpol::*regex-delimiters* (cons *default-step-regex-delimiter*
+                                                   cl-interpol::*regex-delimiters*)))
+        (cl-interpol:enable-interpol-syntax)
+        (mapc #'load (sort files #'string<
+                           :key (lambda (path)
+                                  (enough-namestring path base-pathname))))))))
+
+(defun serve-cucumber-requests (socket &aux (stream (socket-stream socket)))
+  (handler-case
+      (loop
+        (let* ((line (read-line stream))
+               (message (read-json line nil))
+               (reply (call-wire-protocol-method message)))
+          (st-json:write-json reply stream)
+          (terpri stream)
+          (finish-output stream)))
+    (end-of-file nil nil)))
+
+
+;;; Step definitions
+
+
+(defparameter *steps* (make-array 0 :adjustable t :fill-pointer t))
+
+(defclass step-definition ()
+     ((regex :initarg :regex :accessor regex)
+      (cont :initarg :continuation :accessor continuation)
+      (scanner :accessor scanner)
+      (definition-file :initform *load-truename* :accessor definition-file)))
+
+(defmethod initialize-instance :after ((o step-definition) &key regex &allow-other-keys)
+  (setf (scanner o) (cl-ppcre:create-scanner regex)))
+
+(defun add-step (regex function)
+  (let ((existing-step (find regex *steps* :key #'regex :test #'string=)))
+    (if existing-step
+        (setf (continuation existing-step) function
+              (definition-file existing-step) *load-truename*)
+        (vector-push-extend
+         (make-instance 'step-definition :regex regex :continuation function)
+         *steps*)))
+  *steps*)
+
+(defmacro clucumber-steps:Given* (regex args &body body)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (add-step ,regex (lambda (,@args) ,@body))))
+
+(defmacro clucumber-steps:Then* (regex args &body body)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (add-step ,regex (lambda (,@args) ,@body))))
+
+(defmacro clucumber-steps:When* (regex args &body body)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (add-step ,regex (lambda (,@args) ,@body))))
+
+;;; Packages
+
+(defun clucumber-external:start (*base-pathname* host port &key quit)
+  (setf (fill-pointer *steps*) 0)
+  (load-definitions *base-pathname*)
+  (let ((server (usocket:socket-listen host port :reuse-address t)))
+    (unwind-protect
+        (loop
+          (let ((socket (usocket:socket-accept server :element-type 'character)))
+            (serve-cucumber-requests socket))
+          (when quit (return)))
+      (usocket:socket-close server))))
+
+(defmacro clucumber-steps:define-test-package (name &rest defpackage-arguments)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
+     (defpackage ,name
+       (:use #:clucumber)
+       ,@defpackage-arguments)
+     (setf *test-package* (find-package ',name))))
+
+;;; Before / after hooks:
+
+;; I'm not sure if these can handle tags. It would certainly be nice if they could.
+
+(defvar *before-hooks* (make-array 0 :adjustable t :fill-pointer t))
+(defvar *after-hooks* (make-array 0 :adjustable t :fill-pointer t))
+
+(defmacro clucumber-steps:Before (&body body)
+  `(vector-push-extend (lambda () ,@body) *before-hooks*))
+
+(defmacro clucumber-steps:After (&body body)
+  `(vector-push-extend (lambda () ,@body) *before-hooks*))
+
+;;; Wire protocol
+
+(defvar *wire-protocol-methods* (make-hash-table :test #'equal))
+
+(defmacro define-wire-protocol-method (name args &body body)
+  (let ((params (gensym)))
+    `(setf (gethash ,name *wire-protocol-methods*)
+           (lambda (,params)
+             (declare (ignorable ,params))
+             (catch 'wire-protocol-method
+               (let (,@(mapcar (lambda (arg-spec)
+                                 (destructuring-bind (arg-name &optional
+                                                               (jso-name (string-downcase arg-name)))
+                                     (if (listp arg-spec) arg-spec (list arg-spec))
+                                   `(,arg-name (getjso ,jso-name ,params))))
+                         args))
+                 ,@body))))))
+
+(defun call-wire-protocol-method (wire-protocol-message)
+  (let ((method (gethash (first wire-protocol-message) *wire-protocol-methods*)))
+    (if method
+        (funcall method
+                 (second wire-protocol-message))
+        (list "fail"))))
+
+(defun clucumber-steps:fail (message &key format-args exception backtrace)
+  (throw 'wire-protocol-method
+    (list "fail"
+          (apply #'jso
+                 `("message" ,(apply #'format nil message format-args)
+                             ,@(when exception
+                                 `("exception" ,exception))
+                             ,@(when backtrace
+                                 `("backtrace" ,backtrace)))))))
+
+(defun clucumber-steps:pending (&optional message)
+  (throw 'wire-protocol-method
+    `("pending" ,@(when message
+                    (list message)))))
+
+(defun backtrace-for (condition)
+  (if *print-backtraces*
+      (trivial-backtrace:print-backtrace condition :output nil)
+      ""))
+
+(defmacro with-error-handling (&body body)
+  `(let ((*debugger-hook* (lambda (condition prev-hook)
+                            (declare (ignore prev-hook))
+                            (fail "Non-error condition invoked the debugger"
+                                  :exception (princ-to-string condition)
+                                  :backtrace (backtrace-for condition)))))
+     (handler-case
+               (progn ,@body)
+             (error (condition)
+               (fail "Caught an error"
+                     :exception (princ-to-string condition)
+                     :backtrace (backtrace-for condition))))))
+
+(define-wire-protocol-method "begin_scenario" ()
+  (with-error-handling
+    (map nil 'funcall *before-hooks*)
+    (list "success")))
+
+(define-wire-protocol-method "end_scenario" ()
+  (with-error-handling
+    (map nil 'funcall *after-hooks*)
+    (reset-state)
+    (list "success")))
+
+(define-wire-protocol-method "step_matches" ((name-to-match "name_to_match"))
+  (list "success"
+        (loop for posn from 0
+              for step across *steps*
+              for scanner = (scanner step)
+              for (matchp end starts ends) = (multiple-value-list (cl-ppcre:scan scanner name-to-match))
+              for arguments = (map 'list (lambda (start end)
+                                           (jso "val" (subseq name-to-match start end)
+                                                "pos" start))
+                                   starts ends)
+              if matchp collect (jso "id" posn "args" arguments
+                                     "regexp" (regex step)
+                                     "source" (enough-namestring (definition-file step)
+                                                     *base-pathname*)))))
+
+(define-wire-protocol-method "invoke" (id args)
+  (let ((step (elt *steps* id)))
+    (if step
+        (with-error-handling
+          (apply (continuation step) args)
+          (list "success"))
+        (fail "Step ~S is undefined" :format-args `(,id)))))
+
+
+(defun make-dwim-step-regex (step)
+  (let* ((escaped (cl-ppcre:regex-replace-all "[][}{)(]" step "\\\\\\&"))
+         (count 0))
+    (values (or (cl-ppcre:regex-replace-all "\"[^\"]+\"" escaped
+                                            (lambda (&rest _)
+                                              (declare (ignore _))
+                                              (incf count)
+                                              "\"([^\"]*)\""))
+                escaped)
+            count)))
+
+(define-wire-protocol-method "snippet_text" ((keyword "step_keyword") (step-name "step_name"))
+  ;; TODO: figure out multiline_arg_class
+  (list "success"
+        (multiple-value-bind (step-re group-count) (make-dwim-step-regex step-name)
+          (let ((group-vars (loop for i from 0 below group-count
+                                  collect (format nil "group-~D" i))))
+            (format nil "(~A* #?~C^~A$~C (~{~A~^ ~})~%  ~
+                           ;; express the regexp above with the code you wish you had~%  ~
+                           (pending))" (string-trim '(#\Space) keyword) *default-step-regex-delimiter*
+                           step-re *default-step-regex-close-delimiter*
+                           group-vars)))))
+
+;;; Sharing state between steps:
+
+(defvar *variables* (make-hash-table :test #'eql))
+
+(defun clucumber-steps:var (name &optional default)
+  (gethash name *variables* default))
+
+(defun (setf clucumber-steps:var) (new-val name &optional default)
+  (setf (gethash name *variables* default) new-val))
+
+(defun reset-state ()
+  (clrhash *variables*))

data/lib/clucumber.rb

@@ -0,0 +1,71 @@
+require 'pty'
+require 'fileutils'
+
+class ClucumberSubprocess
+  class LaunchFailed < RuntimeError; end
+  
+  attr_reader :output
+
+  def initialize(dir, options={})
+    @dir = dir
+    lisp = options[:lisp] || ENV['LISP'] || 'sbcl --disable-debugger'
+    @port = options[:port] || raise("Need a port to run clucumber on.")
+    @output = ""
+    
+    Dir.chdir(@dir) do
+      @out, @in, @pid = PTY.spawn(lisp)
+    end
+    @reader = Thread.start {
+      record_output
+    }
+    @in.puts(<<-LISP)
+      (require :asdf)
+      (load #p"#{File.expand_path("clucumber/clucumber.asd", File.dirname(__FILE__))}")
+    LISP
+  end
+  
+  def start(additional_forms="")
+    @in.puts <<-LISP
+      #{additional_forms}
+      (asdf:oos 'asdf:load-op :clucumber)
+      (clucumber-external:start #p"./" "localhost" #{@port})
+    LISP
+    until socket = TCPSocket.new("localhost", @port) rescue nil
+      raise LaunchFailed, "Couldn't start clucumber:\n#{@output}" unless alive?
+      sleep 0.01
+    end
+    File.open(File.join(@dir, "step_definitions", "clucumber.wire"), "w") do |out|
+      YAML.dump({'host' => "localhost", 'port' => @port}, out)
+    end
+    socket.close
+  end
+
+  def record_output
+    begin
+      while line = @out.readline
+        @output << line
+      end
+    rescue PTY::ChildExited
+      STDOUT.puts "child exited, stopping."
+      nil
+    end
+  end
+
+  def kill
+    if @pid
+      FileUtils.rm_f File.join(@dir, "step_definitions", "clucumber.wire")
+      @reader.terminate!
+      Process.kill("TERM", @pid)
+      Process.waitpid(@pid)
+      @pid = nil
+    end
+  rescue PTY::ChildExited
+    @pid = nil
+  end
+
+  def alive?
+    if !@pid.nil?
+      (Process.kill("CONT", @pid) && true) rescue false
+    end
+  end
+end

data/test/helper.rb

@@ -0,0 +1,10 @@
+require 'rubygems'
+require 'test/unit'
+require 'shoulda'
+
+$LOAD_PATH.unshift(File.join(File.dirname(__FILE__), '..', 'lib'))
+$LOAD_PATH.unshift(File.dirname(__FILE__))
+require 'clucumber'
+
+class Test::Unit::TestCase
+end

data/test/test_clucumber.rb

@@ -0,0 +1,7 @@
+require 'helper'
+
+class TestClucumber < Test::Unit::TestCase
+  should "probably rename this file and start testing for real" do
+    flunk "hey buddy, you should probably rename this file and start testing for real"
+  end
+end

metadata

@@ -0,0 +1,94 @@
+--- !ruby/object:Gem::Specification 
+name: clucumber
+version: !ruby/object:Gem::Version 
+  prerelease: false
+  segments: 
+  - 0
+  - 1
+  - 0
+  version: 0.1.0
+platform: ruby
+authors: 
+- Andreas Fuchs
+autorequire: 
+bindir: bin
+cert_chain: []
+
+date: 2010-05-03 00:00:00 +02:00
+default_executable: 
+dependencies: 
+- !ruby/object:Gem::Dependency 
+  name: aruba
+  prerelease: false
+  requirement: &id001 !ruby/object:Gem::Requirement 
+    requirements: 
+    - - ">="
+      - !ruby/object:Gem::Version 
+        segments: 
+        - 0
+        version: "0"
+  type: :development
+  version_requirements: *id001
+- !ruby/object:Gem::Dependency 
+  name: cucumber
+  prerelease: false
+  requirement: &id002 !ruby/object:Gem::Requirement 
+    requirements: 
+    - - ">="
+      - !ruby/object:Gem::Version 
+        segments: 
+        - 0
+        version: "0"
+  type: :development
+  version_requirements: *id002
+description: |-
+  A cucumber extension that lets you write your step definitions in Common Lisp. 
+        Set internal state in your Hunchentoot web app or your library, and use the full power of Cucumber and its other extensions.
+email: asf@boinkor.net
+executables: []
+
+extensions: []
+
+extra_rdoc_files: 
+- LICENSE
+- README.rdoc
+files: 
+- lib/clucumber.rb
+- lib/clucumber/clucumber.asd
+- lib/clucumber/packages.lisp
+- lib/clucumber/server.lisp
+- LICENSE
+- README.rdoc
+has_rdoc: true
+homepage: http://github.com/antifuchs/clucumber
+licenses: []
+
+post_install_message: 
+rdoc_options: 
+- --charset=UTF-8
+require_paths: 
+- lib
+required_ruby_version: !ruby/object:Gem::Requirement 
+  requirements: 
+  - - ">="
+    - !ruby/object:Gem::Version 
+      segments: 
+      - 0
+      version: "0"
+required_rubygems_version: !ruby/object:Gem::Requirement 
+  requirements: 
+  - - ">="
+    - !ruby/object:Gem::Version 
+      segments: 
+      - 0
+      version: "0"
+requirements: []
+
+rubyforge_project: 
+rubygems_version: 1.3.6
+signing_key: 
+specification_version: 3
+summary: Test drive your Common Lisp application from Cucumber
+test_files: 
+- test/helper.rb
+- test/test_clucumber.rb