clucumber 0.1.1 → 0.2.0

data/lib/clucumber/vendor/cl-unicode/packages.lisp

@@ -0,0 +1,76 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/packages.lisp,v 1.24 2008/07/24 14:46:20 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-user)
+
+(defpackage :cl-unicode
+  (:use :cl)
+  (:import-from :cl-ppcre
+                :*standard-optimize-settings*
+                :with-rebinding)
+  (:export :+code-point-limit+
+           :*scripts-to-try*
+           :*try-abbreviations-p*
+           :*try-hex-notation-p*
+           :*try-lisp-names-p*
+           :*try-unicode1-names-p*
+           :age
+           :bidi-class
+           :bidi-classes
+           :bidi-mirroring-glyph
+           :binary-properties
+           :canonicalize-name
+           :character-named
+           :code-block
+           :code-blocks
+           :combining-class
+           :disable-alternative-character-syntax
+           :enable-alternative-character-syntax
+           :general-categories
+           :general-category
+           :has-binary-property
+           :has-property
+           :list-all-characters
+           :lowercase-mapping
+           :numeric-type
+           :numeric-value
+           :property-name
+           :property-symbol
+           :property-test
+           :recognized-properties
+           :script
+           :scripts
+           :titlecase-mapping
+           :unicode-error
+           :unicode-name
+           :unicode1-name
+           :uppercase-mapping))
+                              
+(defpackage :cl-unicode-names
+  (:use))

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

@@ -0,0 +1,135 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/specials.lisp,v 1.16 2008/07/24 14:50:37 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-unicode)
+
+(defconstant +code-point-limit+ #x110000
+  "The smallest integer which is not a code point in the Unicode codespace.")
+
+(defvar *canonical-names* (make-hash-table :test 'eq :size 500)
+  "A hash tables which maps property symbols \(see PROPERTY-SYMBOL) to
+their \"canonical names\", i.e. to strings.")
+
+(defvar *names-to-code-points* (make-hash-table :test 'equalp :size 20000)
+  "A hash table which \(case-insensitively) maps \"canonicalized\"
+character names to their code points.")
+
+(defvar *unicode1-names-to-code-points* (make-hash-table :test 'equalp :size 2000)
+  "A hash table which \(case-insensitively) maps \"canonicalized\"
+Unicode 1.0 character names to their code points.")
+
+(defvar *code-points-to-names* (make-hash-table :size 20000)
+  "A hash table which maps code points to the corresponding character
+names.")
+
+(defvar *code-points-to-unicode1-names* (make-hash-table :size 2000)
+  "A hash table which maps code points to the corresponding Unicode
+1.0 character names.")
+
+(defvar *case-mappings* (make-hash-table :size 2100)
+  "A hash table which maps code points to three-element lists
+containing the lowercase, uppercase, and titlecasse mapping of the
+corresponding character \(unless all of them are NIL).")
+
+(defvar *general-categories* nil
+  "A list of all property symbols which denote general categories.")
+
+(defvar *scripts* nil
+  "A list of all property symbols which denote scripts.")
+
+(defvar *code-blocks* nil
+  "A list of all property symbols which denote blocks.")
+
+(defvar *binary-properties* nil
+  "A list of all property symbols which denote binary properties.")
+
+(defvar *bidi-classes* nil
+  "A list of all property symbols which denote Bidi classes.")
+
+(defvar *property-map* (make-hash-table :test 'equalp :size 1000)
+  "A hash table which \(case-insensitively) maps \"canonicalized\"
+property names \(including aliases) to the corresponding property
+symbols.")
+
+(defvar *property-tests* (make-hash-table :test 'eq :size 360)
+  "A hash table which maps property symbols to a test function which
+tests for the corresponding property.")
+
+(defvar *jamo-short-names* (make-hash-table :size 70)
+  "A hash table which maps code points to their Jamo short names.
+Needed to compute Hangul syllable names - see COMPUTE-HANGUL-NAME.")
+
+(defvar *hangul-syllables-to-code-points* (make-hash-table :test 'equalp :size 12000)
+  "A hash table which \(case-insensitively) maps Hangul syllable name
+parts to their code points.")
+
+(defvar *try-unicode1-names-p* t
+  "This is the default value for the :TRY-UNICODE1-NAMES-P keyword
+argument to CHARACTER-NAMED.")
+
+(defvar *try-abbreviations-p* nil
+  "This is the default value for the :TRY-ABBREVIATIONS-P keyword
+argument to CHARACTER-NAMED.")
+
+(defvar *scripts-to-try* nil
+  "This is the default value for the :SCRIPTS-TO-TRY keyword argument
+to CHARACTER-NAMED.")
+
+(defvar *try-hex-notation-p* nil
+  "This is the default value for the :TRY-HEX-NOTATION-P keyword
+argument to CHARACTER-NAMED.")
+
+(defvar *try-lisp-names-p* nil
+  "This is the default value for the :TRY-LISP-NAMES-P keyword
+argument to CHARACTER-NAMED.")
+
+(defvar *previous-readtables* nil
+  "A stack which holds the previous readtables that have been pushed
+here by ENABLE-ALTERNATIVE-CHARACTER-SYNTAX.")
+
+(pushnew :cl-unicode *features*)
+
+;; stuff for Nikodemus Siivola's HYPERDOC
+;; see <http://common-lisp.net/project/hyperdoc/>
+;; and <http://www.cliki.net/hyperdoc>
+;; also used by LW-ADD-ONS
+
+(defvar *hyperdoc-base-uri* "http://weitz.de/cl-unicode/")
+
+(let ((exported-symbols-alist
+       (loop for symbol being the external-symbols of :cl-unicode
+             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-unicode/test/packages.lisp

@@ -0,0 +1,34 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/test/packages.lisp,v 1.2 2008/07/20 12:21:22 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-unicode-test
+  (:use :cl :cl-unicode)
+  (:export :run-all-tests))

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

@@ -0,0 +1,150 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE-TEST; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/test/tests.lisp,v 1.17 2008/07/23 11:25:07 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-unicode-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*))
+                          verbose)
+  "Loops through all the forms in the file FILE-NAME and executes each
+of them using EVAL.  Reads all forms with the alternative character
+syntax enabled.  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.  Returns a true value iff all tests succeeded."
+  (enable-alternative-character-syntax)
+  (unwind-protect
+      (with-open-file (stream file-name)
+        (let ((*package* (find-package :cl-unicode-test))
+              (*try-unicode1-names-p* t)
+              (*try-abbreviations-p* t)
+              (*scripts-to-try* '("Hebrew"))
+              (*try-hex-notation-p* t)
+              (*try-lisp-names-p* t))
+          (do-tests ((format nil "Simple tests from file ~S" (file-namestring file-name))
+                     (not verbose))
+            (let ((form (or (read stream nil) (done))))
+              (when verbose
+                (format t "~&~S" form))
+              (cond ((eval form) nil)
+                    (t (list (format nil "~S returned NIL" form))))))))
+    (disable-alternative-character-syntax)))
+
+(defun property-tests (&key (file-name
+                             (make-pathname :name "properties"
+                                            :type nil :version nil
+                                            :defaults *this-file*))
+                            verbose)
+  "Loops through all the forms in the file FILE-NAME and executes each
+of them as a test for a property.  The forms must be lists \(C S B)
+where C is a code point \(an integer), S is a string denoting the
+property, and B is boolean denoting whether the character has the
+property or not.  Tests are performed using HAS-PROPERTY.  Prints each
+test to *STANDARD-OUTPUT* if VERBOSE is true and shows a simple
+progress indicator otherwise.  Returns a true value iff all tests
+succeeded."
+  (with-open-file (stream file-name)
+    (do-tests ((format nil "Properties from file ~S" (file-namestring file-name))
+               (not verbose))
+      (let ((input-line (or (read stream nil) (done))))
+        (destructuring-bind (char-code property-name expected-result)
+            input-line
+          (when verbose
+            (format t "~&~A: #x~X" property-name char-code))
+          (let* ((char (and (< char-code char-code-limit) (code-char char-code)))
+                 (result-1 (has-property char-code property-name))
+                 (result-2 (and char (has-property char property-name)))
+                 errors)
+            (unless (eq expected-result (not (not result-1)))
+              (push (format nil "code point #x~X should ~:[not ~;~]have property \"~A\""
+                            char-code expected-result property-name)
+                    errors))
+            (when char
+              (unless (eq expected-result (not (not result-2)))
+                (push (format nil "\(code-char #x~X) should ~:[not ~;~]have property \"~A\""
+                              char-code expected-result property-name)
+                      errors)))
+            errors))))))
+
+(defun run-all-tests (&key verbose)
+  "Runs all tests for CL-UNICODE 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 tests for derived properties
+      (run-test-suite (property-tests :verbose verbose
+                                      :file-name (make-pathname :name "derived-properties"
+                                                                :type nil :version nil
+                                                                :defaults *this-file*)))
+      (run-test-suite (property-tests :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-unicode/test-functions.lisp

@@ -0,0 +1,94 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-UNICODE; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-unicode/test-functions.lisp,v 1.6 2008/07/21 20:04: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-unicode)
+
+(defun install-one-test (property-symbol test-function)
+  (setf (gethash property-symbol *property-tests*)
+        test-function
+        (gethash (canonicalize-name (property-name property-symbol)) *property-map*)
+        property-symbol))
+
+(defun install-script-tests ()
+  (dolist (script *scripts*)
+    (install-one-test script 
+                      (let ((script script))
+                        (lambda (c)
+                          (eq (nth-value 1 (script c)) script))))))
+
+(defun install-code-block-tests ()
+  (dolist (code-block *code-blocks*)
+    (install-one-test (register-property-symbol
+                       (format nil "Block:~A" (property-name code-block)))
+                      (let ((code-block code-block))
+                        (lambda (c)
+                          (eq (nth-value 1 (code-block c)) code-block))))))
+
+(defun install-general-category-tests ()
+  (dolist (general-category *general-categories*)
+    (install-one-test general-category
+                      (let ((general-category general-category))
+                        (lambda (c)
+                          (eq (nth-value 1 (general-category c)) general-category))))))
+
+(defun install-binary-properties-tests ()
+  (dolist (binary-property *binary-properties*)
+    (install-one-test binary-property
+                      (let ((binary-property binary-property))
+                        (lambda (c)
+                          (has-binary-property c binary-property))))))
+
+(defun install-bidi-class-tests ()
+  (dolist (bidi-class *bidi-classes*)
+    (install-one-test (register-property-symbol
+                       (format nil "BidiClass:~A" (property-name bidi-class)))
+                      (let ((bidi-class bidi-class))
+                        (lambda (c)
+                          (eq (nth-value 1 (bidi-class c)) bidi-class))))))
+
+(defun install-miscellaneous-tests ()
+  (install-one-test (register-property-symbol "ASCII")
+                    (lambda (c)
+                      (<= 0 (ensure-code-point c) 127)))
+  (install-one-test (register-property-symbol "Assigned")
+                    (lambda (c)
+                      (not (eq (nth-value 1 (general-category c))
+                               '#.(property-symbol "Cn")))))
+  (install-one-test (register-property-symbol "GraphemeLink")
+                    (lambda (c)
+                      ;; Canonical_Combining_Class=Virama
+                      (eql (combining-class c) 9))))
+
+(defun install-tests ()
+  (install-script-tests)
+  (install-code-block-tests)
+  (install-general-category-tests)
+  (install-binary-properties-tests)
+  (install-bidi-class-tests)
+  (install-miscellaneous-tests))