clucumber 0.1.1 → 0.2.0

data/lib/clucumber/vendor/cl-interpol/specials.lisp

@@ -0,0 +1,113 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/specials.lisp,v 1.12 2008/07/23 13:58:40 edi Exp $
+
+;;; Copyright (c) 2003-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-interpol)
+
+(defvar *list-delimiter* #\Space
+  "What is inserted between the elements of a list which is
+interpolated by #\@.")
+
+(defvar *inner-delimiters* '((#\( . #\))
+                             (#\{ . #\})
+                             (#\< . #\>)
+                             (#\[ . #\]))
+  "Legal delimiters for interpolation with #\$ and #\@.")
+                             
+(defvar *outer-delimiters* '((#\( . #\))
+                             (#\{ . #\})
+                             (#\< . #\>)
+                             (#\[ . #\])
+                             #\/ #\| #\" #\' #\#)
+  "Legal outer delimiters for CL-INTERPOL strings.")
+
+(defvar *regex-delimiters* '(#\/)
+  "Outer delimiters which automatically enable regex mode.")
+
+(defvar *unicode-aliases*
+  (make-hash-table :test #'equalp)
+  "A hash table which maps Unicode aliases to their real names.")
+
+(defvar *optional-delimiters-p* nil
+  "Whether text following $ or @ should interpolate even without a
+following delimiter.  Lexical variables are handled correctly,
+but the rules are somewhat complex -- see the docs for details.")
+
+(defmacro defvar-unbound (variable-name documentation)
+  "Like DEFVAR, but the variable will be unbound rather than getting
+an initial value.  This is useful for variables which should have no
+global value but might have a dynamically bound value."
+  ;; stolen from comp.lang.lisp article <k7727i3s.fsf@comcast.net> by
+  ;; "prunesquallor@comcast.net"
+  `(eval-when (:load-toplevel :compile-toplevel :execute)
+    (defvar ,variable-name)
+    (setf (documentation ',variable-name 'variable)
+            ,documentation)))
+
+(defvar-unbound *saw-backslash*
+  "Whether we have to re-process an \L or \U because it closes several
+scopes.")
+
+(defvar-unbound *pair-level*
+  "")
+
+(defvar-unbound *stream*
+  "Bound to the stream which is read from while parsing a string.")
+
+(defvar-unbound *start-char*
+  "Bound to the opening outer delimiter while parsing a string.")
+
+(defvar-unbound *term-char*
+  "Bound to the closing outer delimiter while parsing a string.")
+
+(defvar *previous-readtables* nil
+  "A stack which holds the previous readtables that have been pushed
+here by ENABLE-INTERPOL-SYNTAX.")
+
+(defvar-unbound *readtable-copy*
+  "Bound to the current readtable if it has to be temporarily
+modified.")
+
+;; stuff for Nikodemus Siivola's HYPERDOC
+;; see <http://common-lisp.net/project/hyperdoc/>
+;; and <http://www.cliki.net/hyperdoc>
+
+(defvar *hyperdoc-base-uri* "http://weitz.de/cl-interpol/")
+
+(let ((exported-symbols-alist
+       (loop for symbol being the external-symbols of :cl-interpol
+             collect (cons symbol
+                           (concatenate 'string
+                                        "#"
+                                        (string-downcase symbol))))))
+  (defun hyperdoc-lookup (symbol type)
+    (declare (ignore type))
+    (cdr (assoc symbol
+                exported-symbols-alist
+                :test #'eq))))
+               

data/lib/clucumber/vendor/cl-interpol/test/packages.lisp

@@ -0,0 +1,34 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/test/packages.lisp,v 1.2 2008/07/23 13:58:44 edi Exp $
+
+;;; Copyright (c) 2002-2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-user)
+
+(defpackage :cl-interpol-test
+  (:use :cl :cl-interpol :cl-unicode)
+  (:export :run-all-tests))

data/lib/clucumber/vendor/cl-interpol/test/tests.lisp

@@ -0,0 +1,128 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL-TEST; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/test/tests.lisp,v 1.4 2008/07/23 16:10:13 edi Exp $
+
+;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-interpol-test)
+
+(defvar *this-file* (load-time-value
+                     (or #.*compile-file-pathname* *load-pathname*))
+  "The location of this source file.  Needed to find the data files.")
+
+(defmacro do-tests ((name &optional show-progress-p) &body body)
+  "Helper macro which repeatedly executes BODY until the code in body
+calls the function DONE.  It is assumed that each invocation of BODY
+will be the execution of one test which returns NIL in case of success
+and a list of strings describing errors otherwise.
+
+The macro prints a simple progress indicator \(one dots for ten tests)
+to *STANDARD-OUTPUT* unless SHOW-PROGRESS-P is NIL and returns a true
+value iff all tests succeeded.  Errors in BODY are caught and reported
+\(and counted as failures)."
+  `(let ((successp t)
+         (testcount 1))
+     (block test-block
+       (flet ((done ()
+                (return-from test-block successp)))
+         (format t "~&Test: ~A~%" ,name)
+         (loop
+          (when (and ,show-progress-p (zerop (mod testcount 10)))
+            (format t ".")
+            (when (zerop (mod testcount 100))
+              (terpri))
+            (force-output))
+          (let ((errors
+                 (handler-case
+                     (progn ,@body)
+                   (error (msg)
+                     (list (format nil "~&got an unexpected error: ~A" msg))))))
+            (setq successp (and successp (null errors)))
+            (when errors
+              (format t "~&~4@A:~{~&   ~A~}~%" testcount errors))
+            (incf testcount)))))
+     successp))
+
+(defun simple-tests (&key (file-name
+                           (make-pathname :name "simple"
+                                          :type nil :version nil
+                                          :defaults *this-file*))                          
+                          (external-format '(:latin-1 :eol-style :lf))
+                          verbose)
+  "Loops through all the forms in the file FILE-NAME and executes each
+of them using EVAL.  The CL-INTERPOL syntax is enabled when the forms
+are read.  It is assumed that each FORM specifies a test which returns
+a true value iff it succeeds.  Prints each test form to
+*STANDARD-OUTPUT* if VERBOSE is true and shows a simple progress
+indicator otherwise.  EXTERNAL-FORMAT is the FLEXI-STREAMS external
+format which is used to read the file.  Returns a true value iff all
+tests succeeded.
+
+\(SETQ ...) forms are treated special in that they're just EVALuated
+but not counted as tests.  The global special variables exported by
+CL-INTERPOL \(and some from CL-UNICODE as well) are rebound during the
+tests so that they can be safely set in the test files."
+  (enable-interpol-syntax)
+  (unwind-protect
+      (with-open-file (binary-stream file-name :element-type 'flex:octet)
+        (let* ((stream (flex:make-flexi-stream binary-stream :external-format external-format))
+               (*package* (find-package :cl-interpol-test))
+               (*list-delimiter* *list-delimiter*)
+               (*outer-delimiters* *outer-delimiters*)
+               (*inner-delimiters* *inner-delimiters*)
+               (*optional-delimiters-p* *optional-delimiters-p*)
+               (*scripts-to-try* *scripts-to-try*)
+               (*try-abbreviations-p* *try-abbreviations-p*)
+               (*try-hex-notation-p* *try-hex-notation-p*)
+               (*try-lisp-names-p* *try-lisp-names-p*)
+               (*try-unicode1-names-p* *try-unicode1-names-p*))
+          (do-tests ((format nil "Simple tests from file ~S" (file-namestring file-name))
+                     (not verbose))
+            (let* ((form (or (read stream nil) (done)))
+                   (setqp (eq (first form) 'setq)))
+              (when (and verbose (not setqp))
+                (format t "~&~S" form))
+              (cond (setqp (eval form) nil)
+                    ((eval form) nil)
+                    (t (list (format nil "~S returned NIL" form))))))))
+    (disable-interpol-syntax)))
+
+(defun run-all-tests (&key verbose)
+  "Runs all tests for CL-INTERPOL and returns a true value iff all
+tests succeeded.  VERBOSE is interpreted by the individual test suites
+above."
+  (let ((successp t))
+    (macrolet ((run-test-suite (&body body)
+                 `(unless (progn ,@body)
+                    (setq successp nil))))
+      ;; run the automatically generated Perl tests
+      (run-test-suite (simple-tests :file-name (make-pathname :name "perltests"
+                                                              :type nil :version nil
+                                                              :defaults *this-file*)
+                                    :verbose verbose))
+      (run-test-suite (simple-tests :verbose verbose)))
+    (format t "~2&~:[Some tests failed~;All tests passed~]." successp)
+    successp))

data/lib/clucumber/vendor/cl-interpol/test.lisp

@@ -0,0 +1,177 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/test.lisp,v 1.9 2004/04/24 00:19:13 edi Exp $
+
+;;; Copyright (c) 2002-2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;;   * Redistributions of source code must retain the above copyright
+;;;     notice, this list of conditions and the following disclaimer.
+
+;;;   * Redistributions in binary form must reproduce the above
+;;;     copyright notice, this list of conditions and the following
+;;;     disclaimer in the documentation and/or other materials
+;;;     provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-interpol)
+
+;; Otherwise it's impossible to see which tests are failing for all
+;; the "helpful" warnings.
+#+sbcl (declaim (optimize (sb-ext:inhibit-warnings 3)))
+
+(defvar *temp*)
+
+(defparameter *cl-interpol-base-directory*
+  (make-pathname :name nil :type nil :version nil
+                 :defaults (parse-namestring *load-truename*)))
+
+(defparameter *test-counter* 0)
+
+(defparameter *failure-counter* 0)
+
+(defun test (form1 form2)
+  (unless (string= form1 form2)
+    (incf *failure-counter*)
+    (format t "~&Test ~A failed: Expected ~S but got ~S~%"
+            (1+ *test-counter*) form2 form1))
+  (incf *test-counter*)
+  (princ #\.)
+  (when (zerop (mod *test-counter* 10))
+    (princ #\Space)
+    (princ *test-counter*)
+    (terpri))
+  (force-output))
+
+(enable-interpol-syntax)
+
+(test #?"abc" "abc")
+(test #?'abc' "abc")
+(test #?|abc| "abc")
+(test #?/abc/ "abc")
+(test #?#abc# "abc")
+(test #?{abc} "abc")
+(test #?(abc) "abc")
+(test #?<abc> "abc")
+(test #?[abc] "abc")
+(test #?"\t\n\r\f\b\a\e"
+                 (coerce (list #\Tab #\Newline #\Return #\Page #\Backspace (code-char 7) (code-char 27))
+                         'string))
+(test #?"\033\x1b\c[\x{1b}"
+                 (make-string 4 :initial-element (code-char 27)))
+(test #?"\x" (string (code-char 0)))
+(test #?"\x001" (format nil "~A1" (code-char 0)))
+(test #?"\0001" (format nil "~A1" (code-char 0)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setq *temp* (list *long-unicode-names-p*
+                     *short-unicode-names-p*
+                     *unicode-scripts*)
+        *long-unicode-names-p* t))
+
+(test #?"\N{LATIN CAPITAL LETTER A WITH DIAERESIS}" "�")
+(test #?"\N{latin capital letter a with diaeresis}" "�")
+(test #?{\N{LATIN CAPITAL LETTER A WITH DIAERESIS}} "�")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setq *short-unicode-names-p* t))
+
+(test #?"\N{Latin:A with Diaeresis}" "�")
+(test #?"\N{Latin:a with diaeresis}" "�")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setq *unicode-scripts* (list "Latin")))
+
+(test #?"\N{A with Diaeresis}" "�")
+(test #?"\N{a with diaeresis}" "�")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setq *long-unicode-names-p* (first *temp*)
+        *short-unicode-names-p* (second *temp*)
+        *unicode-scripts* (third *temp*)))
+
+(test #?/\1/ "\\1")
+(test #?r"\1" "\\1")
+(test #?x/abc / "abc")
+(test #?x/abc
+                         / "abc")
+(test #?rx"abc " "abc")
+(test #?/[\1]\1/ (format nil "[~A]\\1" (code-char 1)))
+(test #?/[(?#foo)](?#foo)/ "[(?#foo)]")
+(test #?/a#bc/ "a#bc")
+(test #?x/a#bc/ "a")
+(test #?x/\d\A[\d\A]/ "\\d\\A[\\dA]")
+
+(test #?"\Q-" "\\-")
+(test #?"\Q-\E-" "\\--")
+(test #?"\ufoo" "Foo")
+(test #?"\Ufoo" "FOO")
+(test #?"\Ufoo\Ebar" "FOObar")
+(test #?"\Ufoo\LBAR" "FOObar")
+
+(let ((a "foo"))
+  (test #?"$" "$")
+  (test #?"@ @" "@ @")
+  (test #?"${a}bar" "foobar")
+  (test #?/${a}bar/ "foobar")
+  (test #?"$[a]bar" "foobar")
+  (test #?"$(a)bar" "foobar")
+  (test #?"$<a>bar" "foobar")
+  (test #?/$<a>bar/ "$<a>bar")
+  (test #?"$a @a " "$a @a "))
+
+(let ((a (list 1 2 3)))
+  (test #?"${a}" "(1 2 3)")
+  (test #?"@{a}" "1 2 3")
+  (let ((*list-delimiter* ""))
+    (test #?"@{a}" "123")))
+
+(let* ((a "foo")
+       (b #\Space)
+       (c "bar")
+       (d (list a b c))
+       (x 40))
+  (test #?"$ @" "$ @")
+  (test #?"$(a)" "foo")
+  (test #?"$<a>$[b]" "foo ")
+  (test #?"\U${a}\E \u${a}" "FOO Foo")
+  (test (let ((cl-interpol:*list-delimiter* #\*))
+          #?"@{d}")
+        "foo* *bar")
+  (test (let ((cl-interpol:*list-delimiter* ""))
+          #?"@{d}")
+        "foo bar")
+  (test #?"The result is ${(let ((y 2)) (+ x y))}"
+        "The result is 42")
+  (test #?"${#?'${a} ${c}'} ${x}" "foo bar 40"))
+
+(setq cl-interpol:*optional-delimiters-p* t)
+(test (let ((% 23)) #?"$%a%b%") "23a%b%")
+(test (let ((%a 23)) #?"$%a%b%") "23%b%")
+(test (let ((%a% 23)) #?"$%a%b%") "23b%")
+(test (let ((%a%b 23)) #?"$%a%b%") "23%")
+(test (let ((%a%b% 23)) #?"$%a%b%") "23")
+(setq cl-interpol:*optional-delimiters-p* nil)
+
+(load (merge-pathnames "test2.lisp"
+                       *cl-interpol-base-directory*))
+
+(disable-interpol-syntax)
+
+(cond ((zerop *failure-counter*)
+        (format t "~&All tests passed."))
+      (t
+        (format t "~&~A tests failed!" *failure-counter*)))