clucumber 0.1.1 → 0.2.0

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

@@ -0,0 +1,37 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-ppcre/test/packages.lisp,v 1.4 2009/09/17 19:17:36 edi Exp $
+
+;;; Copyright (c) 2002-2009, 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-ppcre-test
+  #+genera (:shadowing-import-from :common-lisp :lambda)
+  (:use #-:genera :cl #+:genera :future-common-lisp :cl-ppcre)
+  (:import-from :cl-ppcre :*standard-optimize-settings*
+                          :string-list-to-simple-string)
+  (:export :run-all-tests :unicode-test))

data/lib/clucumber/vendor/cl-ppcre/test/perl-tests.lisp

@@ -0,0 +1,150 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE-TEST; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-ppcre/test/perl-tests.lisp,v 1.8 2009/09/17 19:17:36 edi Exp $
+
+;;; The tests in this file test CL-PPCRE against testdata generated by
+;;; the Perl program `perltest.pl' from the input file `testinput' in
+;;; order to check compatibility with Perl and correctness of the
+;;; regex engine.
+
+;;; Copyright (c) 2002-2009, 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-ppcre-test)
+
+(defvar *tests-to-skip* '(662 790 1439)
+  "Some tests we skip because the testdata is generated by a Perl
+program and CL-PPCRE differs from Perl for these tests - on purpose.")
+
+(defun create-string-from-input (input)
+  "Converts INPUT to a string which can be used in TEST below.  The
+input file `testdata' encodes strings containing non-printable
+characters as lists where those characters are represented by their
+character code."
+  (etypecase input
+    ((or null string) input)
+    (list (string-list-to-simple-string
+           (loop for element in input
+                 if (stringp element)
+                 collect element
+                 else
+                 collect (string (code-char element)))))))
+
+(defun perl-test (&key (file-name 
+                        (make-pathname :name "perltestdata"
+                                       :type nil :version nil
+                                       :defaults *this-file*)
+                        file-name-provided-p)
+                       (external-format '(:latin-1 :eol-style :lf))
+                       verbose)
+  "Loops through all test cases in FILE-NAME and prints a report if
+VERBOSE is true.  EXTERNAL-FORMAT is the FLEXI-STREAMS external format
+which is used to read the file.  Returns a true value if all tests
+succeeded.
+
+For the syntax of the tests in FILE-NAME refer to the source code of
+this function and to the Perl script perltest.pl which generates such
+test files."
+  (declare #.*standard-optimize-settings*)
+  (with-open-file (binary-stream file-name :element-type 'flex:octet)
+    (let ((stream (flex:make-flexi-stream binary-stream :external-format external-format))
+          ;; the standard Perl tests don't need full Unicode support
+          (*regex-char-code-limit* (if file-name-provided-p *regex-char-code-limit* 256))
+          ;; we need this for the standard test suite or otherwise we
+          ;; might get stack overflows
+          (*optimize-char-classes* (if file-name-provided-p *optimize-char-classes* :charmap))
+          ;; we only check for correctness and don't care about speed
+          ;; that match (but rather about space constraints of the
+          ;; trial versions)
+          (*use-bmh-matchers* (if file-name-provided-p *use-bmh-matchers* nil))
+          ;; some tests in the Perl suite explicitly check for this
+          (*allow-quoting* (if file-name-provided-p *allow-quoting* t)))
+      (do-tests ((format nil "Running tests in file ~S" (file-namestring file-name))
+                 (not verbose))
+        (let ((input-line (or (read stream nil) (done)))
+              errors)
+          (destructuring-bind (counter
+                               info-string%
+                               regex%
+                               case-insensitive-mode
+                               multi-line-mode
+                               single-line-mode
+                               extended-mode
+                               target%
+                               perl-error
+                               expected-result%
+                               expected-registers)
+              input-line
+            (destructuring-bind (info-string regex target expected-result)
+                (mapcar 'create-string-from-input
+                        (list info-string% regex% target% expected-result%))
+              (setq expected-registers (mapcar 'create-string-from-input expected-registers))
+              (unless (find counter *tests-to-skip* :test #'=)
+                (when verbose
+                  (format t "~&~4D: ~S" counter info-string))                  
+                (let ((scanner
+                       (handler-bind ((error (lambda (condition)
+                                               (declare (ignore condition))
+                                               (when perl-error
+                                                 ;; we expected an
+                                                 ;; error, so we can
+                                                 ;; signal success
+                                                 (return-from test-block)))))
+                         (create-scanner regex
+                                         :case-insensitive-mode case-insensitive-mode
+                                         :multi-line-mode multi-line-mode
+                                         :single-line-mode single-line-mode
+                                         :extended-mode extended-mode))))
+                  (block test-block
+                    (multiple-value-bind (start end reg-starts reg-ends)                        
+                        (scan scanner target)
+                      (cond (perl-error
+                             (push (format nil "expected an error but got a result.")
+                                   errors))
+                            (t
+                             (when (not (eq start expected-result))
+                               (if start
+                                 (let ((result (subseq target start end)))
+                                   (unless (string= result expected-result)
+                                     (push (format nil "expected ~S but got ~S."
+                                                   expected-result result)
+                                           errors))
+                                   (setq reg-starts (coerce reg-starts 'list)
+                                         reg-ends (coerce reg-ends 'list))
+                                   (loop for i from 0
+                                         for expected-register in expected-registers
+                                         for reg-start = (nth i reg-starts)
+                                         for reg-end = (nth i reg-ends)
+                                         for register = (if (and reg-start reg-end)
+                                                          (subseq target reg-start reg-end)
+                                                          nil)
+                                         unless (string= expected-register register)
+                                         do (push (format nil "\\~A: expected ~S but got ~S."
+                                                          (1+ i) expected-register register)
+                                                  errors)))
+                                 (push (format nil "expected ~S but got ~S."
+                                               expected-result start)
+                                       errors))))))
+                    errors))))))))))

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

@@ -0,0 +1,159 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE-TEST; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-ppcre/test/tests.lisp,v 1.13 2009/09/17 19:17:36 edi Exp $
+
+;;; The tests in this file test CL-PPCRE against testdata generated by
+;;; the Perl program `perltest.pl' from the input file `testinput' in
+;;; order to check compatibility with Perl and correctness of the
+;;; regex engine.
+
+;;; Copyright (c) 2002-2009, 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-ppcre-test)
+
+(defvar *this-file* (load-time-value
+                     (or #.*compile-file-pathname* *load-pathname*))
+  "The location of this source file.")
+
+(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 list of string 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.  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."
+  (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-ppcre-test)))
+      (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)))))))))
+
+(defun random-test-function (probability)
+  "Returns a random character test function which contains each
+character with probability PROBABILITY."
+  (let ((hash-table (make-hash-table)))
+    (dotimes (code char-code-limit)
+      (let ((char (code-char code)))
+        (when (and char (< (random 1.0d0) probability))
+          (setf (gethash (code-char code) hash-table) t))))
+    (lambda (char)
+      (gethash char hash-table))))
+
+(defun test-optimized-test-functions% (probability)
+  "Creates a random test function with probability PROBABILITY and six
+\(one for each possible \"kind\") corresponding optimized test
+functions, then checks for each character in turn that all functions
+agree on it."
+  (let* ((test-function (random-test-function probability))
+         (optimized-functions (loop for kind in '(nil
+                                                  :hash-table
+                                                  :hash-table*
+                                                  :charset
+                                                  :charset*
+                                                  :charmap)
+                                    collect (create-optimized-test-function test-function :kind kind))))
+    (loop for code below char-code-limit
+          for char = (code-char code)
+          for expected-result = (and char (funcall test-function char))
+          always (or (null char)
+                     (loop for optimized-function in optimized-functions
+                           always (eq (not (funcall optimized-function char))
+                                      (not expected-result)))))))
+
+(defun test-optimized-test-functions (&key verbose)
+  "Runs TEST-OPTIMIZED-TEST-FUNCTIONS% with different probabilities."
+  (let ((probabilities '(0 .001 .01 .1 1)))
+    (do-tests ("Optimized test functions - this might take some time..." (not verbose))
+      (let ((probability (or (pop probabilities) (done))))
+        (when verbose
+          (format t "~&Probability is ~A" probability))
+        (not (test-optimized-test-functions% probability))))))
+
+(defun run-all-tests (&key more-tests verbose)
+  "Runs all tests for CL-PPCRE and returns a true value iff all tests
+succeeded.  VERBOSE is interpreted by the individual test suites.
+MORE-TESTS can be a list of function designators designating
+additional tests to run.  This facility is used by the tests for
+CL-PPCRE-UNICODE."
+  (let ((successp t))
+    (macrolet ((run-test-suite (&body body)
+                 `(unless (progn ,@body)
+                    (setq successp nil))))
+      ;; run the automatically generated Perl tests
+      (run-test-suite (perl-test :verbose verbose))
+      (run-test-suite (test-optimized-test-functions :verbose verbose))
+      (run-test-suite (simple-tests :verbose verbose))
+      (when more-tests
+        (unless (listp more-tests)
+          (setq more-tests (list more-tests))
+          (dolist (test more-tests)
+            (run-test-suite (funcall test :verbose verbose))))))
+    (format t "~2&~:[Some tests failed~;All tests passed~]." successp)
+    successp))

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

@@ -0,0 +1,80 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE-TEST; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-ppcre/test/unicode-tests.lisp,v 1.8 2008/07/23 00:17:53 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-ppcre-test)
+
+(defun unicode-test (&key (file-name 
+                           (make-pathname :name "unicodetestdata"
+                                          :type nil :version nil
+                                          :defaults *this-file*)
+                           file-name-provided-p)
+                          verbose)
+  "Loops through all test cases in FILE-NAME and prints a report if
+VERBOSE is true.  Returns a true value if all tests succeeded.
+
+For the syntax of the tests in FILE-NAME refer to CL-UNICODE."
+  (with-open-file (stream file-name)
+    (let ((*regex-char-code-limit* (if file-name-provided-p *regex-char-code-limit* char-code-limit))
+          (*optimize-char-classes* (if file-name-provided-p *optimize-char-classes* nil))
+          ;; we only check for correctness and don't care about speed
+          ;; that match (but rather about space constraints of the
+          ;; trial versions)
+          (*use-bmh-matchers* (if file-name-provided-p *use-bmh-matchers* nil)))
+      (do-tests ((format nil "Running Unicode tests in file ~S" (file-namestring file-name))
+                 (not verbose))
+        (let ((input-line (or (read stream nil) (done)))
+              errors)
+          (destructuring-bind (char-code property-name expected-result)
+              input-line
+            (let ((char (and (< char-code char-code-limit) (code-char char-code))))
+              (when char
+                (when verbose
+                  (format t "~&~A: #x~X" property-name char-code))
+                (let* ((string (string char))
+                       (result-1 (scan (format nil "\\p{~A}" property-name) string))
+                       (result-2 (scan (format nil "[\\p{~A}]" property-name) string))
+                       (inverted-result-1 (scan (format nil "\\P{~A}" property-name) string))
+                       (inverted-result-2 (scan (format nil "[\\P{~A}]" property-name) string)))
+                  (unless (eq expected-result (not (not result-1)))
+                    (push (format nil "\(code-char #x~X) should ~:[not ~;~]have matched \"\\p{~A}\""
+                                  char-code expected-result property-name)
+                          errors))
+                  (unless (eq expected-result (not (not result-2)))
+                    (push (format nil "\(code-char #x~X) should ~:[not ~;~]have matched \"[\\p{~A}]\""
+                                  char-code expected-result property-name)
+                          errors))
+                  (unless (eq expected-result (not inverted-result-1))
+                    (push (format nil "\(code-char #x~X) should ~:[~;not ~]have matched \"\\P{~A}\""
+                                  char-code expected-result property-name)
+                          errors))
+                  (unless (eq expected-result (not inverted-result-2))
+                    (push (format nil "\(code-char #x~X) should ~:[~;not ~]have matched \"[\\P{~A}]\""
+                                  char-code expected-result property-name)
+                          errors)))
+                errors))))))))

data/lib/clucumber/vendor/cl-ppcre/util.lisp

@@ -0,0 +1,201 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-ppcre/util.lisp,v 1.48 2009/10/28 07:36:15 edi Exp $
+
+;;; Utility functions and constants dealing with the character sets we
+;;; use to encode character classes
+
+;;; Copyright (c) 2002-2009, 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-ppcre)
+
+(defmacro defconstant (name value &optional doc)
+  "Make sure VALUE is evaluated only once \(to appease SBCL)."
+  `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
+     ,@(when doc (list doc))))
+
+#+:lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (import 'lw:with-unique-names))
+
+#-:lispworks
+(defmacro with-unique-names ((&rest bindings) &body body)
+  "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form*
+
+Executes a series of forms with each VAR bound to a fresh,
+uninterned symbol. The uninterned symbol is as if returned by a call
+to GENSYM with the string denoted by X - or, if X is not supplied, the
+string denoted by VAR - as argument.
+
+The variable bindings created are lexical unless special declarations
+are specified. The scopes of the name bindings and declarations do not
+include the Xs.
+
+The forms are evaluated in order, and the values of all but the last
+are discarded \(that is, the body is an implicit PROGN)."
+  ;; reference implementation posted to comp.lang.lisp as
+  ;; <cy3bshuf30f.fsf@ljosa.com> by Vebjorn Ljosa - see also
+  ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
+  `(let ,(mapcar #'(lambda (binding)
+                     (check-type binding (or cons symbol))
+                     (if (consp binding)
+                       (destructuring-bind (var x) binding
+                         (check-type var symbol)
+                         `(,var (gensym ,(etypecase x
+                                          (symbol (symbol-name x))
+                                          (character (string x))
+                                          (string x)))))
+                       `(,binding (gensym ,(symbol-name binding)))))
+                 bindings)
+         ,@body))
+
+#+:lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (setf (macro-function 'with-rebinding)
+          (macro-function 'lw:rebinding)))
+
+#-:lispworks
+(defmacro with-rebinding (bindings &body body)
+  "WITH-REBINDING ( { var | (var prefix) }* ) form*
+
+Evaluates a series of forms in the lexical environment that is
+formed by adding the binding of each VAR to a fresh, uninterned
+symbol, and the binding of that fresh, uninterned symbol to VAR's
+original value, i.e., its value in the current lexical environment.
+
+The uninterned symbol is created as if by a call to GENSYM with the
+string denoted by PREFIX - or, if PREFIX is not supplied, the string
+denoted by VAR - as argument.
+
+The forms are evaluated in order, and the values of all but the last
+are discarded \(that is, the body is an implicit PROGN)."
+  ;; reference implementation posted to comp.lang.lisp as
+  ;; <cy3wv0fya0p.fsf@ljosa.com> by Vebjorn Ljosa - see also
+  ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
+  (loop for binding in bindings
+        for var = (if (consp binding) (car binding) binding)
+        for name = (gensym)
+        collect `(,name ,var) into renames
+        collect ``(,,var ,,name) into temps
+        finally (return `(let ,renames
+                          (with-unique-names ,bindings
+                            `(let (,,@temps)
+                              ,,@body))))))
+
+(declaim (inline digit-char-p))  
+(defun digit-char-p (chr)
+  (declare #.*standard-optimize-settings*)
+  "Tests whether a character is a decimal digit, i.e. the same as
+Perl's [\\d].  Note that this function shadows the standard Common
+Lisp function CL:DIGIT-CHAR-P."
+  (char<= #\0 chr #\9))
+
+(declaim (inline word-char-p))  
+(defun word-char-p (chr)
+  (declare #.*standard-optimize-settings*)
+  "Tests whether a character is a \"word\" character.  In the ASCII
+charset this is equivalent to a-z, A-Z, 0-9, or _, i.e. the same as
+Perl's [\\w]."
+  (or (alphanumericp chr)
+      (char= chr #\_)))
+
+(defconstant +whitespace-char-string+
+  (coerce '(#\Space #\Tab #\Linefeed #\Return #\Page) 'string)
+  "A string of all characters which are considered to be whitespace.
+Same as Perl's [\\s].")
+
+(defun whitespacep (chr)
+  (declare #.*special-optimize-settings*)
+  "Tests whether a character is whitespace, i.e. whether it would
+match [\\s] in Perl."
+  (find chr +whitespace-char-string+ :test #'char=))
+
+(defmacro maybe-coerce-to-simple-string (string)
+  "Coerces STRING to a simple STRING unless it already is one."
+  (with-unique-names (=string=)
+    `(let ((,=string= ,string))
+      (cond (#+:lispworks
+             (lw:simple-text-string-p ,=string=)
+             #-:lispworks
+             (simple-string-p ,=string=)
+              ,=string=)
+            (t
+             (coerce ,=string=
+                     #+:lispworks 'lw:simple-text-string
+                     #-:lispworks 'simple-string))))))
+
+(declaim (inline nsubseq))
+(defun nsubseq (sequence start &optional (end (length sequence)))
+  "Returns a subsequence by pointing to location in original sequence."
+  (make-array (- end start)
+              :element-type (array-element-type sequence)
+              :displaced-to sequence
+              :displaced-index-offset start))
+
+(defun normalize-var-list (var-list)
+  "Utility function for REGISTER-GROUPS-BIND and DO-REGISTER-GROUPS.
+Creates the long form \(a list of \(FUNCTION VAR) entries) out of the
+short form of VAR-LIST."
+  (loop for element in var-list
+        if (consp element)
+          nconc (loop for var in (rest element)
+                      collect (list (first element) var))
+        else
+          collect (list '(function identity) element)))
+
+(defun string-list-to-simple-string (string-list)
+  "Concatenates a list of strings to one simple-string."
+  (declare #.*standard-optimize-settings*)
+  ;; this function provided by JP Massar; note that we can't use APPLY
+  ;; with CONCATENATE here because of CALL-ARGUMENTS-LIMIT
+  (let ((total-size 0))
+    (declare (fixnum total-size))
+    (dolist (string string-list)
+      #-:genera (declare (string string))
+      (incf total-size (length string)))
+    (let ((result-string (make-sequence #-:lispworks 'simple-string
+                                        #+:lispworks 'lw:simple-text-string
+                                        total-size))
+          (curr-pos 0))
+      (declare (fixnum curr-pos))
+      (dolist (string string-list)
+        #-:genera (declare (string string))
+        (replace result-string string :start1 curr-pos)
+        (incf curr-pos (length string)))
+      result-string)))
+
+(defun complement* (test-function)
+  "Like COMPLEMENT but optimized for unary functions."
+  (declare #.*standard-optimize-settings*)
+  (typecase test-function
+    (function
+     (lambda (char)
+       (declare (character char))
+       (not (funcall (the function test-function) char))))
+    (otherwise
+     (lambda (char)
+       (declare (character char))
+       (not (funcall test-function char))))))