clucumber 0.1.1 → 0.2.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (139) hide show
  1. data/LICENSE +1 -1
  2. data/README.md +4 -9
  3. data/lib/clucumber/clucumber-bootstrap.lisp +32 -0
  4. data/lib/clucumber/vendor/cl-interpol/alias.lisp +55 -0
  5. data/lib/clucumber/vendor/cl-interpol/cl-interpol.asd +56 -0
  6. data/lib/clucumber/vendor/cl-interpol/load.lisp +53 -0
  7. data/lib/clucumber/vendor/cl-interpol/packages.lisp +40 -0
  8. data/lib/clucumber/vendor/cl-interpol/read.lisp +716 -0
  9. data/lib/clucumber/vendor/cl-interpol/specials.lisp +113 -0
  10. data/lib/clucumber/vendor/cl-interpol/test/packages.lisp +34 -0
  11. data/lib/clucumber/vendor/cl-interpol/test/tests.lisp +128 -0
  12. data/lib/clucumber/vendor/cl-interpol/test.lisp +177 -0
  13. data/lib/clucumber/vendor/cl-interpol/test2.lisp +6254 -0
  14. data/lib/clucumber/vendor/cl-interpol/unicode.lisp +13912 -0
  15. data/lib/clucumber/vendor/cl-interpol/util.lisp +122 -0
  16. data/lib/clucumber/vendor/cl-ppcre/api.lisp +1262 -0
  17. data/lib/clucumber/vendor/cl-ppcre/charmap.lisp +152 -0
  18. data/lib/clucumber/vendor/cl-ppcre/charset.lisp +242 -0
  19. data/lib/clucumber/vendor/cl-ppcre/chartest.lisp +98 -0
  20. data/lib/clucumber/vendor/cl-ppcre/cl-ppcre-test.asd +34 -0
  21. data/lib/clucumber/vendor/cl-ppcre/cl-ppcre-unicode/packages.lisp +38 -0
  22. data/lib/clucumber/vendor/cl-ppcre/cl-ppcre-unicode/resolver.lisp +61 -0
  23. data/lib/clucumber/vendor/cl-ppcre/cl-ppcre-unicode.asd +58 -0
  24. data/lib/clucumber/vendor/cl-ppcre/cl-ppcre.asd +79 -0
  25. data/lib/clucumber/vendor/cl-ppcre/closures.lisp +471 -0
  26. data/lib/clucumber/vendor/cl-ppcre/convert.lisp +875 -0
  27. data/lib/clucumber/vendor/cl-ppcre/errors.lisp +84 -0
  28. data/lib/clucumber/vendor/cl-ppcre/lexer.lisp +737 -0
  29. data/lib/clucumber/vendor/cl-ppcre/lispworks-defsystem.lisp +57 -0
  30. data/lib/clucumber/vendor/cl-ppcre/load.lisp +67 -0
  31. data/lib/clucumber/vendor/cl-ppcre/optimize.lisp +578 -0
  32. data/lib/clucumber/vendor/cl-ppcre/packages.lisp +68 -0
  33. data/lib/clucumber/vendor/cl-ppcre/parser.lisp +319 -0
  34. data/lib/clucumber/vendor/cl-ppcre/ppcre-tests.lisp +269 -0
  35. data/lib/clucumber/vendor/cl-ppcre/regex-class-util.lisp +555 -0
  36. data/lib/clucumber/vendor/cl-ppcre/regex-class.lisp +259 -0
  37. data/lib/clucumber/vendor/cl-ppcre/repetition-closures.lisp +833 -0
  38. data/lib/clucumber/vendor/cl-ppcre/scanner.lisp +506 -0
  39. data/lib/clucumber/vendor/cl-ppcre/specials.lisp +172 -0
  40. data/lib/clucumber/vendor/cl-ppcre/test/packages.lisp +37 -0
  41. data/lib/clucumber/vendor/cl-ppcre/test/perl-tests.lisp +150 -0
  42. data/lib/clucumber/vendor/cl-ppcre/test/tests.lisp +159 -0
  43. data/lib/clucumber/vendor/cl-ppcre/test/unicode-tests.lisp +80 -0
  44. data/lib/clucumber/vendor/cl-ppcre/util.lisp +201 -0
  45. data/lib/clucumber/vendor/cl-unicode/alias.lisp +135 -0
  46. data/lib/clucumber/vendor/cl-unicode/api.lisp +412 -0
  47. data/lib/clucumber/vendor/cl-unicode/build/char-info.lisp +133 -0
  48. data/lib/clucumber/vendor/cl-unicode/build/dump.lisp +239 -0
  49. data/lib/clucumber/vendor/cl-unicode/build/read.lisp +280 -0
  50. data/lib/clucumber/vendor/cl-unicode/build/util.lisp +182 -0
  51. data/lib/clucumber/vendor/cl-unicode/cl-unicode.asd +90 -0
  52. data/lib/clucumber/vendor/cl-unicode/conditions.lisp +54 -0
  53. data/lib/clucumber/vendor/cl-unicode/derived.lisp +120 -0
  54. data/lib/clucumber/vendor/cl-unicode/hash-tables.lisp +20 -0
  55. data/lib/clucumber/vendor/cl-unicode/lists.lisp +10 -0
  56. data/lib/clucumber/vendor/cl-unicode/methods.lisp +15 -0
  57. data/lib/clucumber/vendor/cl-unicode/packages.lisp +76 -0
  58. data/lib/clucumber/vendor/cl-unicode/specials.lisp +135 -0
  59. data/lib/clucumber/vendor/cl-unicode/test/packages.lisp +34 -0
  60. data/lib/clucumber/vendor/cl-unicode/test/tests.lisp +150 -0
  61. data/lib/clucumber/vendor/cl-unicode/test-functions.lisp +94 -0
  62. data/lib/clucumber/vendor/cl-unicode/util.lisp +274 -0
  63. data/lib/clucumber/vendor/lift/compare/fiveam-tests.lisp +14 -0
  64. data/lib/clucumber/vendor/lift/compare/lift-tests.lisp +13 -0
  65. data/lib/clucumber/vendor/lift/compare/rt-tests.lisp +16 -0
  66. data/lib/clucumber/vendor/lift/compare/xlunit-tests.lisp +15 -0
  67. data/lib/clucumber/vendor/lift/dev/changes.lisp +61 -0
  68. data/lib/clucumber/vendor/lift/dev/config.lisp +354 -0
  69. data/lib/clucumber/vendor/lift/dev/copy-file.lisp +117 -0
  70. data/lib/clucumber/vendor/lift/dev/introspection.lisp +232 -0
  71. data/lib/clucumber/vendor/lift/dev/lift-interface.lisp +56 -0
  72. data/lib/clucumber/vendor/lift/dev/lift-notes.lisp +202 -0
  73. data/lib/clucumber/vendor/lift/dev/lift-randomized.lisp +45 -0
  74. data/lib/clucumber/vendor/lift/dev/lift.lisp +2383 -0
  75. data/lib/clucumber/vendor/lift/dev/macros.lisp +229 -0
  76. data/lib/clucumber/vendor/lift/dev/measuring.lisp +156 -0
  77. data/lib/clucumber/vendor/lift/dev/packages.lisp +161 -0
  78. data/lib/clucumber/vendor/lift/dev/port.lisp +151 -0
  79. data/lib/clucumber/vendor/lift/dev/prototypes.lisp +282 -0
  80. data/lib/clucumber/vendor/lift/dev/random-testing.lisp +124 -0
  81. data/lib/clucumber/vendor/lift/dev/report-locations.lisp +13 -0
  82. data/lib/clucumber/vendor/lift/dev/reports.lisp +916 -0
  83. data/lib/clucumber/vendor/lift/dev/utilities.lisp +242 -0
  84. data/lib/clucumber/vendor/lift/docs/package.lisp +6 -0
  85. data/lib/clucumber/vendor/lift/docs/setup.lisp +17 -0
  86. data/lib/clucumber/vendor/lift/examples/basic-examples.lisp +289 -0
  87. data/lib/clucumber/vendor/lift/examples/random-testing.lisp +32 -0
  88. data/lib/clucumber/vendor/lift/lift-documentation.asd +28 -0
  89. data/lib/clucumber/vendor/lift/lift-test.asd +35 -0
  90. data/lib/clucumber/vendor/lift/lift.asd +77 -0
  91. data/lib/clucumber/vendor/lift/test/equality-tests.lisp +40 -0
  92. data/lib/clucumber/vendor/lift/test/finding-tests.lisp +32 -0
  93. data/lib/clucumber/vendor/lift/test/lift-test.lisp +783 -0
  94. data/lib/clucumber/vendor/lift/test/order-of-operations.lisp +54 -0
  95. data/lib/clucumber/vendor/lift/test/packages.lisp +17 -0
  96. data/lib/clucumber/vendor/lift/test/test-config-files.lisp +20 -0
  97. data/lib/clucumber/vendor/lift/test/test-dynamic-variables.lisp +57 -0
  98. data/lib/clucumber/vendor/lift/test/test-maximum-problems.lisp +74 -0
  99. data/lib/clucumber/vendor/lift/test/test-prototypes.lisp +278 -0
  100. data/lib/clucumber/vendor/lift/test/test-timeout.lisp +37 -0
  101. data/lib/clucumber/vendor/lift/test/tests-in-progress.lisp +62 -0
  102. data/lib/clucumber/vendor/lift/test/testsuite-expects.lisp +60 -0
  103. data/lib/clucumber/vendor/lift/timeout/package.lisp +13 -0
  104. data/lib/clucumber/vendor/lift/timeout/with-timeout.lisp +123 -0
  105. data/lib/clucumber/vendor/lift/website/stuff/Temp.lisp +34 -0
  106. data/lib/clucumber/vendor/st-json/st-json.asd +3 -0
  107. data/lib/clucumber/vendor/st-json/st-json.lisp +310 -0
  108. data/lib/clucumber/vendor/trivial-backtrace/dev/backtrace.lisp +127 -0
  109. data/lib/clucumber/vendor/trivial-backtrace/dev/fallback.lisp +10 -0
  110. data/lib/clucumber/vendor/trivial-backtrace/dev/map-backtrace.lisp +103 -0
  111. data/lib/clucumber/vendor/trivial-backtrace/dev/mucking.lisp +75 -0
  112. data/lib/clucumber/vendor/trivial-backtrace/dev/packages.lisp +13 -0
  113. data/lib/clucumber/vendor/trivial-backtrace/dev/utilities.lisp +104 -0
  114. data/lib/clucumber/vendor/trivial-backtrace/test/packages.lisp +5 -0
  115. data/lib/clucumber/vendor/trivial-backtrace/test/test-setup.lisp +4 -0
  116. data/lib/clucumber/vendor/trivial-backtrace/test/tests.lisp +16 -0
  117. data/lib/clucumber/vendor/trivial-backtrace/trivial-backtrace-test.asd +22 -0
  118. data/lib/clucumber/vendor/trivial-backtrace/trivial-backtrace.asd +35 -0
  119. data/lib/clucumber/vendor/usocket/backend/allegro.lisp +199 -0
  120. data/lib/clucumber/vendor/usocket/backend/armedbear.lisp +491 -0
  121. data/lib/clucumber/vendor/usocket/backend/clisp.lisp +260 -0
  122. data/lib/clucumber/vendor/usocket/backend/cmucl.lisp +266 -0
  123. data/lib/clucumber/vendor/usocket/backend/lispworks.lisp +741 -0
  124. data/lib/clucumber/vendor/usocket/backend/mcl.lisp +369 -0
  125. data/lib/clucumber/vendor/usocket/backend/openmcl.lisp +206 -0
  126. data/lib/clucumber/vendor/usocket/backend/sbcl.lisp +424 -0
  127. data/lib/clucumber/vendor/usocket/backend/scl.lisp +261 -0
  128. data/lib/clucumber/vendor/usocket/condition.lisp +227 -0
  129. data/lib/clucumber/vendor/usocket/package.lisp +82 -0
  130. data/lib/clucumber/vendor/usocket/server.lisp +45 -0
  131. data/lib/clucumber/vendor/usocket/test/package.lisp +13 -0
  132. data/lib/clucumber/vendor/usocket/test/test-usocket.lisp +166 -0
  133. data/lib/clucumber/vendor/usocket/usocket-test.asd +26 -0
  134. data/lib/clucumber/vendor/usocket/usocket.asd +37 -0
  135. data/lib/clucumber/vendor/usocket/usocket.lisp +542 -0
  136. data/lib/clucumber/vendor/usocket/vendor/kqueue.lisp +1 -0
  137. data/lib/clucumber/vendor/usocket/vendor/split-sequence.lisp +245 -0
  138. data/lib/clucumber.rb +29 -7
  139. metadata +151 -5
@@ -0,0 +1,37 @@
1
+ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
2
+ ;;; $Header: /usr/local/cvsrep/cl-ppcre/test/packages.lisp,v 1.4 2009/09/17 19:17:36 edi Exp $
3
+
4
+ ;;; Copyright (c) 2002-2009, Dr. Edmund Weitz. All rights reserved.
5
+
6
+ ;;; Redistribution and use in source and binary forms, with or without
7
+ ;;; modification, are permitted provided that the following conditions
8
+ ;;; are met:
9
+
10
+ ;;; * Redistributions of source code must retain the above copyright
11
+ ;;; notice, this list of conditions and the following disclaimer.
12
+
13
+ ;;; * Redistributions in binary form must reproduce the above
14
+ ;;; copyright notice, this list of conditions and the following
15
+ ;;; disclaimer in the documentation and/or other materials
16
+ ;;; provided with the distribution.
17
+
18
+ ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19
+ ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20
+ ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21
+ ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22
+ ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23
+ ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24
+ ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25
+ ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26
+ ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27
+ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28
+ ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
+
30
+ (in-package :cl-user)
31
+
32
+ (defpackage :cl-ppcre-test
33
+ #+genera (:shadowing-import-from :common-lisp :lambda)
34
+ (:use #-:genera :cl #+:genera :future-common-lisp :cl-ppcre)
35
+ (:import-from :cl-ppcre :*standard-optimize-settings*
36
+ :string-list-to-simple-string)
37
+ (:export :run-all-tests :unicode-test))
@@ -0,0 +1,150 @@
1
+ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE-TEST; Base: 10 -*-
2
+ ;;; $Header: /usr/local/cvsrep/cl-ppcre/test/perl-tests.lisp,v 1.8 2009/09/17 19:17:36 edi Exp $
3
+
4
+ ;;; The tests in this file test CL-PPCRE against testdata generated by
5
+ ;;; the Perl program `perltest.pl' from the input file `testinput' in
6
+ ;;; order to check compatibility with Perl and correctness of the
7
+ ;;; regex engine.
8
+
9
+ ;;; Copyright (c) 2002-2009, Dr. Edmund Weitz. All rights reserved.
10
+
11
+ ;;; Redistribution and use in source and binary forms, with or without
12
+ ;;; modification, are permitted provided that the following conditions
13
+ ;;; are met:
14
+
15
+ ;;; * Redistributions of source code must retain the above copyright
16
+ ;;; notice, this list of conditions and the following disclaimer.
17
+
18
+ ;;; * Redistributions in binary form must reproduce the above
19
+ ;;; copyright notice, this list of conditions and the following
20
+ ;;; disclaimer in the documentation and/or other materials
21
+ ;;; provided with the distribution.
22
+
23
+ ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
24
+ ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
25
+ ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26
+ ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
27
+ ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28
+ ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
29
+ ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
30
+ ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
31
+ ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
32
+ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
33
+ ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
+
35
+ (in-package :cl-ppcre-test)
36
+
37
+ (defvar *tests-to-skip* '(662 790 1439)
38
+ "Some tests we skip because the testdata is generated by a Perl
39
+ program and CL-PPCRE differs from Perl for these tests - on purpose.")
40
+
41
+ (defun create-string-from-input (input)
42
+ "Converts INPUT to a string which can be used in TEST below. The
43
+ input file `testdata' encodes strings containing non-printable
44
+ characters as lists where those characters are represented by their
45
+ character code."
46
+ (etypecase input
47
+ ((or null string) input)
48
+ (list (string-list-to-simple-string
49
+ (loop for element in input
50
+ if (stringp element)
51
+ collect element
52
+ else
53
+ collect (string (code-char element)))))))
54
+
55
+ (defun perl-test (&key (file-name
56
+ (make-pathname :name "perltestdata"
57
+ :type nil :version nil
58
+ :defaults *this-file*)
59
+ file-name-provided-p)
60
+ (external-format '(:latin-1 :eol-style :lf))
61
+ verbose)
62
+ "Loops through all test cases in FILE-NAME and prints a report if
63
+ VERBOSE is true. EXTERNAL-FORMAT is the FLEXI-STREAMS external format
64
+ which is used to read the file. Returns a true value if all tests
65
+ succeeded.
66
+
67
+ For the syntax of the tests in FILE-NAME refer to the source code of
68
+ this function and to the Perl script perltest.pl which generates such
69
+ test files."
70
+ (declare #.*standard-optimize-settings*)
71
+ (with-open-file (binary-stream file-name :element-type 'flex:octet)
72
+ (let ((stream (flex:make-flexi-stream binary-stream :external-format external-format))
73
+ ;; the standard Perl tests don't need full Unicode support
74
+ (*regex-char-code-limit* (if file-name-provided-p *regex-char-code-limit* 256))
75
+ ;; we need this for the standard test suite or otherwise we
76
+ ;; might get stack overflows
77
+ (*optimize-char-classes* (if file-name-provided-p *optimize-char-classes* :charmap))
78
+ ;; we only check for correctness and don't care about speed
79
+ ;; that match (but rather about space constraints of the
80
+ ;; trial versions)
81
+ (*use-bmh-matchers* (if file-name-provided-p *use-bmh-matchers* nil))
82
+ ;; some tests in the Perl suite explicitly check for this
83
+ (*allow-quoting* (if file-name-provided-p *allow-quoting* t)))
84
+ (do-tests ((format nil "Running tests in file ~S" (file-namestring file-name))
85
+ (not verbose))
86
+ (let ((input-line (or (read stream nil) (done)))
87
+ errors)
88
+ (destructuring-bind (counter
89
+ info-string%
90
+ regex%
91
+ case-insensitive-mode
92
+ multi-line-mode
93
+ single-line-mode
94
+ extended-mode
95
+ target%
96
+ perl-error
97
+ expected-result%
98
+ expected-registers)
99
+ input-line
100
+ (destructuring-bind (info-string regex target expected-result)
101
+ (mapcar 'create-string-from-input
102
+ (list info-string% regex% target% expected-result%))
103
+ (setq expected-registers (mapcar 'create-string-from-input expected-registers))
104
+ (unless (find counter *tests-to-skip* :test #'=)
105
+ (when verbose
106
+ (format t "~&~4D: ~S" counter info-string))
107
+ (let ((scanner
108
+ (handler-bind ((error (lambda (condition)
109
+ (declare (ignore condition))
110
+ (when perl-error
111
+ ;; we expected an
112
+ ;; error, so we can
113
+ ;; signal success
114
+ (return-from test-block)))))
115
+ (create-scanner regex
116
+ :case-insensitive-mode case-insensitive-mode
117
+ :multi-line-mode multi-line-mode
118
+ :single-line-mode single-line-mode
119
+ :extended-mode extended-mode))))
120
+ (block test-block
121
+ (multiple-value-bind (start end reg-starts reg-ends)
122
+ (scan scanner target)
123
+ (cond (perl-error
124
+ (push (format nil "expected an error but got a result.")
125
+ errors))
126
+ (t
127
+ (when (not (eq start expected-result))
128
+ (if start
129
+ (let ((result (subseq target start end)))
130
+ (unless (string= result expected-result)
131
+ (push (format nil "expected ~S but got ~S."
132
+ expected-result result)
133
+ errors))
134
+ (setq reg-starts (coerce reg-starts 'list)
135
+ reg-ends (coerce reg-ends 'list))
136
+ (loop for i from 0
137
+ for expected-register in expected-registers
138
+ for reg-start = (nth i reg-starts)
139
+ for reg-end = (nth i reg-ends)
140
+ for register = (if (and reg-start reg-end)
141
+ (subseq target reg-start reg-end)
142
+ nil)
143
+ unless (string= expected-register register)
144
+ do (push (format nil "\\~A: expected ~S but got ~S."
145
+ (1+ i) expected-register register)
146
+ errors)))
147
+ (push (format nil "expected ~S but got ~S."
148
+ expected-result start)
149
+ errors))))))
150
+ errors))))))))))
@@ -0,0 +1,159 @@
1
+ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE-TEST; Base: 10 -*-
2
+ ;;; $Header: /usr/local/cvsrep/cl-ppcre/test/tests.lisp,v 1.13 2009/09/17 19:17:36 edi Exp $
3
+
4
+ ;;; The tests in this file test CL-PPCRE against testdata generated by
5
+ ;;; the Perl program `perltest.pl' from the input file `testinput' in
6
+ ;;; order to check compatibility with Perl and correctness of the
7
+ ;;; regex engine.
8
+
9
+ ;;; Copyright (c) 2002-2009, Dr. Edmund Weitz. All rights reserved.
10
+
11
+ ;;; Redistribution and use in source and binary forms, with or without
12
+ ;;; modification, are permitted provided that the following conditions
13
+ ;;; are met:
14
+
15
+ ;;; * Redistributions of source code must retain the above copyright
16
+ ;;; notice, this list of conditions and the following disclaimer.
17
+
18
+ ;;; * Redistributions in binary form must reproduce the above
19
+ ;;; copyright notice, this list of conditions and the following
20
+ ;;; disclaimer in the documentation and/or other materials
21
+ ;;; provided with the distribution.
22
+
23
+ ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
24
+ ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
25
+ ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26
+ ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
27
+ ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28
+ ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
29
+ ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
30
+ ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
31
+ ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
32
+ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
33
+ ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
+
35
+ (in-package :cl-ppcre-test)
36
+
37
+ (defvar *this-file* (load-time-value
38
+ (or #.*compile-file-pathname* *load-pathname*))
39
+ "The location of this source file.")
40
+
41
+ (defmacro do-tests ((name &optional show-progress-p) &body body)
42
+ "Helper macro which repeatedly executes BODY until the code in body
43
+ calls the function DONE. It is assumed that each invocation of BODY
44
+ will be the execution of one test which returns NIL in case of success
45
+ and list of string describing errors otherwise.
46
+
47
+ The macro prints a simple progress indicator \(one dots for ten tests)
48
+ to *STANDARD-OUTPUT* unless SHOW-PROGRESS-P is NIL and returns a true
49
+ value iff all tests succeeded. Errors in BODY are caught and reported
50
+ \(and counted as failures)."
51
+ `(let ((successp t)
52
+ (testcount 1))
53
+ (block test-block
54
+ (flet ((done ()
55
+ (return-from test-block successp)))
56
+ (format t "~&Test: ~A~%" ,name)
57
+ (loop
58
+ (when (and ,show-progress-p (zerop (mod testcount 10)))
59
+ (format t ".")
60
+ (when (zerop (mod testcount 100))
61
+ (terpri))
62
+ (force-output))
63
+ (let ((errors
64
+ (handler-case
65
+ (progn ,@body)
66
+ (error (msg)
67
+ (list (format nil "~&got an unexpected error: ~A" msg))))))
68
+ (setq successp (and successp (null errors)))
69
+ (when errors
70
+ (format t "~&~4@A:~{~& ~A~}~%" testcount errors))
71
+ (incf testcount)))))
72
+ successp))
73
+
74
+ (defun simple-tests (&key (file-name
75
+ (make-pathname :name "simple"
76
+ :type nil :version nil
77
+ :defaults *this-file*))
78
+ (external-format '(:latin-1 :eol-style :lf))
79
+ verbose)
80
+ "Loops through all the forms in the file FILE-NAME and executes each
81
+ of them using EVAL. It is assumed that each FORM specifies a test
82
+ which returns a true value iff it succeeds. Prints each test form to
83
+ *STANDARD-OUTPUT* if VERBOSE is true and shows a simple progress
84
+ indicator otherwise. EXTERNAL-FORMAT is the FLEXI-STREAMS external
85
+ format which is used to read the file. Returns a true value iff all
86
+ tests succeeded."
87
+ (with-open-file (binary-stream file-name :element-type 'flex:octet)
88
+ (let ((stream (flex:make-flexi-stream binary-stream :external-format external-format))
89
+ (*package* (find-package :cl-ppcre-test)))
90
+ (do-tests ((format nil "Simple tests from file ~S" (file-namestring file-name))
91
+ (not verbose))
92
+ (let ((form (or (read stream nil) (done))))
93
+ (when verbose
94
+ (format t "~&~S" form))
95
+ (cond ((eval form) nil)
96
+ (t (list (format nil "~S returned NIL" form)))))))))
97
+
98
+ (defun random-test-function (probability)
99
+ "Returns a random character test function which contains each
100
+ character with probability PROBABILITY."
101
+ (let ((hash-table (make-hash-table)))
102
+ (dotimes (code char-code-limit)
103
+ (let ((char (code-char code)))
104
+ (when (and char (< (random 1.0d0) probability))
105
+ (setf (gethash (code-char code) hash-table) t))))
106
+ (lambda (char)
107
+ (gethash char hash-table))))
108
+
109
+ (defun test-optimized-test-functions% (probability)
110
+ "Creates a random test function with probability PROBABILITY and six
111
+ \(one for each possible \"kind\") corresponding optimized test
112
+ functions, then checks for each character in turn that all functions
113
+ agree on it."
114
+ (let* ((test-function (random-test-function probability))
115
+ (optimized-functions (loop for kind in '(nil
116
+ :hash-table
117
+ :hash-table*
118
+ :charset
119
+ :charset*
120
+ :charmap)
121
+ collect (create-optimized-test-function test-function :kind kind))))
122
+ (loop for code below char-code-limit
123
+ for char = (code-char code)
124
+ for expected-result = (and char (funcall test-function char))
125
+ always (or (null char)
126
+ (loop for optimized-function in optimized-functions
127
+ always (eq (not (funcall optimized-function char))
128
+ (not expected-result)))))))
129
+
130
+ (defun test-optimized-test-functions (&key verbose)
131
+ "Runs TEST-OPTIMIZED-TEST-FUNCTIONS% with different probabilities."
132
+ (let ((probabilities '(0 .001 .01 .1 1)))
133
+ (do-tests ("Optimized test functions - this might take some time..." (not verbose))
134
+ (let ((probability (or (pop probabilities) (done))))
135
+ (when verbose
136
+ (format t "~&Probability is ~A" probability))
137
+ (not (test-optimized-test-functions% probability))))))
138
+
139
+ (defun run-all-tests (&key more-tests verbose)
140
+ "Runs all tests for CL-PPCRE and returns a true value iff all tests
141
+ succeeded. VERBOSE is interpreted by the individual test suites.
142
+ MORE-TESTS can be a list of function designators designating
143
+ additional tests to run. This facility is used by the tests for
144
+ CL-PPCRE-UNICODE."
145
+ (let ((successp t))
146
+ (macrolet ((run-test-suite (&body body)
147
+ `(unless (progn ,@body)
148
+ (setq successp nil))))
149
+ ;; run the automatically generated Perl tests
150
+ (run-test-suite (perl-test :verbose verbose))
151
+ (run-test-suite (test-optimized-test-functions :verbose verbose))
152
+ (run-test-suite (simple-tests :verbose verbose))
153
+ (when more-tests
154
+ (unless (listp more-tests)
155
+ (setq more-tests (list more-tests))
156
+ (dolist (test more-tests)
157
+ (run-test-suite (funcall test :verbose verbose))))))
158
+ (format t "~2&~:[Some tests failed~;All tests passed~]." successp)
159
+ successp))
@@ -0,0 +1,80 @@
1
+ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE-TEST; Base: 10 -*-
2
+ ;;; $Header: /usr/local/cvsrep/cl-ppcre/test/unicode-tests.lisp,v 1.8 2008/07/23 00:17:53 edi Exp $
3
+
4
+ ;;; Copyright (c) 2008, Dr. Edmund Weitz. All rights reserved.
5
+
6
+ ;;; Redistribution and use in source and binary forms, with or without
7
+ ;;; modification, are permitted provided that the following conditions
8
+ ;;; are met:
9
+
10
+ ;;; * Redistributions of source code must retain the above copyright
11
+ ;;; notice, this list of conditions and the following disclaimer.
12
+
13
+ ;;; * Redistributions in binary form must reproduce the above
14
+ ;;; copyright notice, this list of conditions and the following
15
+ ;;; disclaimer in the documentation and/or other materials
16
+ ;;; provided with the distribution.
17
+
18
+ ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
19
+ ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20
+ ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21
+ ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
22
+ ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23
+ ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
24
+ ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25
+ ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26
+ ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27
+ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28
+ ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
+
30
+ (in-package :cl-ppcre-test)
31
+
32
+ (defun unicode-test (&key (file-name
33
+ (make-pathname :name "unicodetestdata"
34
+ :type nil :version nil
35
+ :defaults *this-file*)
36
+ file-name-provided-p)
37
+ verbose)
38
+ "Loops through all test cases in FILE-NAME and prints a report if
39
+ VERBOSE is true. Returns a true value if all tests succeeded.
40
+
41
+ For the syntax of the tests in FILE-NAME refer to CL-UNICODE."
42
+ (with-open-file (stream file-name)
43
+ (let ((*regex-char-code-limit* (if file-name-provided-p *regex-char-code-limit* char-code-limit))
44
+ (*optimize-char-classes* (if file-name-provided-p *optimize-char-classes* nil))
45
+ ;; we only check for correctness and don't care about speed
46
+ ;; that match (but rather about space constraints of the
47
+ ;; trial versions)
48
+ (*use-bmh-matchers* (if file-name-provided-p *use-bmh-matchers* nil)))
49
+ (do-tests ((format nil "Running Unicode tests in file ~S" (file-namestring file-name))
50
+ (not verbose))
51
+ (let ((input-line (or (read stream nil) (done)))
52
+ errors)
53
+ (destructuring-bind (char-code property-name expected-result)
54
+ input-line
55
+ (let ((char (and (< char-code char-code-limit) (code-char char-code))))
56
+ (when char
57
+ (when verbose
58
+ (format t "~&~A: #x~X" property-name char-code))
59
+ (let* ((string (string char))
60
+ (result-1 (scan (format nil "\\p{~A}" property-name) string))
61
+ (result-2 (scan (format nil "[\\p{~A}]" property-name) string))
62
+ (inverted-result-1 (scan (format nil "\\P{~A}" property-name) string))
63
+ (inverted-result-2 (scan (format nil "[\\P{~A}]" property-name) string)))
64
+ (unless (eq expected-result (not (not result-1)))
65
+ (push (format nil "\(code-char #x~X) should ~:[not ~;~]have matched \"\\p{~A}\""
66
+ char-code expected-result property-name)
67
+ errors))
68
+ (unless (eq expected-result (not (not result-2)))
69
+ (push (format nil "\(code-char #x~X) should ~:[not ~;~]have matched \"[\\p{~A}]\""
70
+ char-code expected-result property-name)
71
+ errors))
72
+ (unless (eq expected-result (not inverted-result-1))
73
+ (push (format nil "\(code-char #x~X) should ~:[~;not ~]have matched \"\\P{~A}\""
74
+ char-code expected-result property-name)
75
+ errors))
76
+ (unless (eq expected-result (not inverted-result-2))
77
+ (push (format nil "\(code-char #x~X) should ~:[~;not ~]have matched \"[\\P{~A}]\""
78
+ char-code expected-result property-name)
79
+ errors)))
80
+ errors))))))))
@@ -0,0 +1,201 @@
1
+ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-PPCRE; Base: 10 -*-
2
+ ;;; $Header: /usr/local/cvsrep/cl-ppcre/util.lisp,v 1.48 2009/10/28 07:36:15 edi Exp $
3
+
4
+ ;;; Utility functions and constants dealing with the character sets we
5
+ ;;; use to encode character classes
6
+
7
+ ;;; Copyright (c) 2002-2009, Dr. Edmund Weitz. All rights reserved.
8
+
9
+ ;;; Redistribution and use in source and binary forms, with or without
10
+ ;;; modification, are permitted provided that the following conditions
11
+ ;;; are met:
12
+
13
+ ;;; * Redistributions of source code must retain the above copyright
14
+ ;;; notice, this list of conditions and the following disclaimer.
15
+
16
+ ;;; * Redistributions in binary form must reproduce the above
17
+ ;;; copyright notice, this list of conditions and the following
18
+ ;;; disclaimer in the documentation and/or other materials
19
+ ;;; provided with the distribution.
20
+
21
+ ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
22
+ ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
23
+ ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24
+ ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
25
+ ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26
+ ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
27
+ ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
28
+ ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
29
+ ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30
+ ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31
+ ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
+
33
+ (in-package :cl-ppcre)
34
+
35
+ (defmacro defconstant (name value &optional doc)
36
+ "Make sure VALUE is evaluated only once \(to appease SBCL)."
37
+ `(cl:defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
38
+ ,@(when doc (list doc))))
39
+
40
+ #+:lispworks
41
+ (eval-when (:compile-toplevel :load-toplevel :execute)
42
+ (import 'lw:with-unique-names))
43
+
44
+ #-:lispworks
45
+ (defmacro with-unique-names ((&rest bindings) &body body)
46
+ "Syntax: WITH-UNIQUE-NAMES ( { var | (var x) }* ) declaration* form*
47
+
48
+ Executes a series of forms with each VAR bound to a fresh,
49
+ uninterned symbol. The uninterned symbol is as if returned by a call
50
+ to GENSYM with the string denoted by X - or, if X is not supplied, the
51
+ string denoted by VAR - as argument.
52
+
53
+ The variable bindings created are lexical unless special declarations
54
+ are specified. The scopes of the name bindings and declarations do not
55
+ include the Xs.
56
+
57
+ The forms are evaluated in order, and the values of all but the last
58
+ are discarded \(that is, the body is an implicit PROGN)."
59
+ ;; reference implementation posted to comp.lang.lisp as
60
+ ;; <cy3bshuf30f.fsf@ljosa.com> by Vebjorn Ljosa - see also
61
+ ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
62
+ `(let ,(mapcar #'(lambda (binding)
63
+ (check-type binding (or cons symbol))
64
+ (if (consp binding)
65
+ (destructuring-bind (var x) binding
66
+ (check-type var symbol)
67
+ `(,var (gensym ,(etypecase x
68
+ (symbol (symbol-name x))
69
+ (character (string x))
70
+ (string x)))))
71
+ `(,binding (gensym ,(symbol-name binding)))))
72
+ bindings)
73
+ ,@body))
74
+
75
+ #+:lispworks
76
+ (eval-when (:compile-toplevel :load-toplevel :execute)
77
+ (setf (macro-function 'with-rebinding)
78
+ (macro-function 'lw:rebinding)))
79
+
80
+ #-:lispworks
81
+ (defmacro with-rebinding (bindings &body body)
82
+ "WITH-REBINDING ( { var | (var prefix) }* ) form*
83
+
84
+ Evaluates a series of forms in the lexical environment that is
85
+ formed by adding the binding of each VAR to a fresh, uninterned
86
+ symbol, and the binding of that fresh, uninterned symbol to VAR's
87
+ original value, i.e., its value in the current lexical environment.
88
+
89
+ The uninterned symbol is created as if by a call to GENSYM with the
90
+ string denoted by PREFIX - or, if PREFIX is not supplied, the string
91
+ denoted by VAR - as argument.
92
+
93
+ The forms are evaluated in order, and the values of all but the last
94
+ are discarded \(that is, the body is an implicit PROGN)."
95
+ ;; reference implementation posted to comp.lang.lisp as
96
+ ;; <cy3wv0fya0p.fsf@ljosa.com> by Vebjorn Ljosa - see also
97
+ ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
98
+ (loop for binding in bindings
99
+ for var = (if (consp binding) (car binding) binding)
100
+ for name = (gensym)
101
+ collect `(,name ,var) into renames
102
+ collect ``(,,var ,,name) into temps
103
+ finally (return `(let ,renames
104
+ (with-unique-names ,bindings
105
+ `(let (,,@temps)
106
+ ,,@body))))))
107
+
108
+ (declaim (inline digit-char-p))
109
+ (defun digit-char-p (chr)
110
+ (declare #.*standard-optimize-settings*)
111
+ "Tests whether a character is a decimal digit, i.e. the same as
112
+ Perl's [\\d]. Note that this function shadows the standard Common
113
+ Lisp function CL:DIGIT-CHAR-P."
114
+ (char<= #\0 chr #\9))
115
+
116
+ (declaim (inline word-char-p))
117
+ (defun word-char-p (chr)
118
+ (declare #.*standard-optimize-settings*)
119
+ "Tests whether a character is a \"word\" character. In the ASCII
120
+ charset this is equivalent to a-z, A-Z, 0-9, or _, i.e. the same as
121
+ Perl's [\\w]."
122
+ (or (alphanumericp chr)
123
+ (char= chr #\_)))
124
+
125
+ (defconstant +whitespace-char-string+
126
+ (coerce '(#\Space #\Tab #\Linefeed #\Return #\Page) 'string)
127
+ "A string of all characters which are considered to be whitespace.
128
+ Same as Perl's [\\s].")
129
+
130
+ (defun whitespacep (chr)
131
+ (declare #.*special-optimize-settings*)
132
+ "Tests whether a character is whitespace, i.e. whether it would
133
+ match [\\s] in Perl."
134
+ (find chr +whitespace-char-string+ :test #'char=))
135
+
136
+ (defmacro maybe-coerce-to-simple-string (string)
137
+ "Coerces STRING to a simple STRING unless it already is one."
138
+ (with-unique-names (=string=)
139
+ `(let ((,=string= ,string))
140
+ (cond (#+:lispworks
141
+ (lw:simple-text-string-p ,=string=)
142
+ #-:lispworks
143
+ (simple-string-p ,=string=)
144
+ ,=string=)
145
+ (t
146
+ (coerce ,=string=
147
+ #+:lispworks 'lw:simple-text-string
148
+ #-:lispworks 'simple-string))))))
149
+
150
+ (declaim (inline nsubseq))
151
+ (defun nsubseq (sequence start &optional (end (length sequence)))
152
+ "Returns a subsequence by pointing to location in original sequence."
153
+ (make-array (- end start)
154
+ :element-type (array-element-type sequence)
155
+ :displaced-to sequence
156
+ :displaced-index-offset start))
157
+
158
+ (defun normalize-var-list (var-list)
159
+ "Utility function for REGISTER-GROUPS-BIND and DO-REGISTER-GROUPS.
160
+ Creates the long form \(a list of \(FUNCTION VAR) entries) out of the
161
+ short form of VAR-LIST."
162
+ (loop for element in var-list
163
+ if (consp element)
164
+ nconc (loop for var in (rest element)
165
+ collect (list (first element) var))
166
+ else
167
+ collect (list '(function identity) element)))
168
+
169
+ (defun string-list-to-simple-string (string-list)
170
+ "Concatenates a list of strings to one simple-string."
171
+ (declare #.*standard-optimize-settings*)
172
+ ;; this function provided by JP Massar; note that we can't use APPLY
173
+ ;; with CONCATENATE here because of CALL-ARGUMENTS-LIMIT
174
+ (let ((total-size 0))
175
+ (declare (fixnum total-size))
176
+ (dolist (string string-list)
177
+ #-:genera (declare (string string))
178
+ (incf total-size (length string)))
179
+ (let ((result-string (make-sequence #-:lispworks 'simple-string
180
+ #+:lispworks 'lw:simple-text-string
181
+ total-size))
182
+ (curr-pos 0))
183
+ (declare (fixnum curr-pos))
184
+ (dolist (string string-list)
185
+ #-:genera (declare (string string))
186
+ (replace result-string string :start1 curr-pos)
187
+ (incf curr-pos (length string)))
188
+ result-string)))
189
+
190
+ (defun complement* (test-function)
191
+ "Like COMPLEMENT but optimized for unary functions."
192
+ (declare #.*standard-optimize-settings*)
193
+ (typecase test-function
194
+ (function
195
+ (lambda (char)
196
+ (declare (character char))
197
+ (not (funcall (the function test-function) char))))
198
+ (otherwise
199
+ (lambda (char)
200
+ (declare (character char))
201
+ (not (funcall test-function char))))))