;;; -*- show-trailing-whitespace: t; indent-tabs-mode: nil -*- ;;; Copyright (c) 2007 Ivan Shvedunov. All rights reserved. ;;; Copyright (c) 2007 David Lichteblau. 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 :xpath) ;; XPath-related tests (defparameter *sample-xml* (concat "" "
" "" "val1" "val2" "" "" "val3" "
" "
" "another-value" "42
" "

5

" "
")) (defparameter *sample-xml-2* (concat "
" "" "val1" "val2" "" "" "val3" "
" "
" "another-value" "42
" "
")) (defparameter *sample-xml-3* " ]>
W X Y Z y w x
") (defparameter *sample-xml-4* (concat "" "" " " " " " " " " " " " " " " "" " " " " " " " " " " " " " " " " " " "" "")) (defparameter *dom-builder* (cxml-dom:make-dom-builder)) (defparameter *document-element* #'dom:document-element) (defmacro define-xpath-test (name &body body) `(deftest ,name (let ((*sample-xml* (cxml:parse-rod *sample-xml* *dom-builder*)) (*sample-xml-2* (cxml:parse-rod *sample-xml-2* *dom-builder*)) (*sample-xml-3* (cxml:parse-rod *sample-xml-3* *dom-builder*)) (*sample-xml-4* (cxml:parse-rod *sample-xml-4* *dom-builder*))) ,@body))) (defun join-xpath-result (result) (if (node-set-p result) (format nil "~{~a~^|||~}" (mapcar #'get-node-text (force (pipe-of result)))) (string-value result))) (defun sample-node-set (&optional (xml "")) (make-node-set (xpath-protocol:child-pipe (funcall *document-element* (cxml:parse-rod (format nil "
~a
" xml) *dom-builder*))))) (define-xpath-test test-values (assert-equal* t (boolean-value t) t (boolean-value 123) t (boolean-value "zzz") t (boolean-value (sample-node-set "")) nil (boolean-value nil) nil (boolean-value 0) nil (boolean-value "") nil (boolean-value (sample-node-set)) 0 (number-value nil) 1 (number-value t) 42 (number-value 42) 4242 (number-value "4242") 1234 (number-value (sample-node-set "12345678")) "false" (string-value nil) "true" (string-value t) "123" (string-value 123) ;; FIXME: more precise stuff for double-float needed "zzzz" (string-value (sample-node-set "zzzzpppp"))) (let ((node-set (sample-node-set ""))) (assert (eq node-set (node-set-value node-set))))) (define-xpath-test test-comparison (flet ((2values (a b) (sample-node-set (format nil "~a~a" a b)))) (assert* (compare-values 'equal 1 1) (not (compare-values 'equal 1 2)) (compare-values 'equal t 1) (not (compare-values 'equal nil 1)) (compare-values 'equal nil nil) (compare-values 'equal t t) (compare-values 'equal "a" "a") (not (compare-values 'equal "b" "a")) (compare-values 'equal "" nil) (not (compare-values 'equal "a" nil)) (compare-values 'equal "a" t) (compare-values 'equal (sample-node-set "qqqfff") (sample-node-set "fffst")) (not (compare-values 'equal (sample-node-set "qqqfff") (sample-node-set "fff1fff3"))) (compare-values 'equal t (sample-node-set "q")) (compare-values 'equal nil (make-node-set nil)) (compare-values 'equal 99 (sample-node-set "12399")) (compare-values 'equal (sample-node-set "12399") 99) (not (compare-values 'equal 42 (sample-node-set "12399"))) (not (compare-values 'equal (sample-node-set "12399") 42)) (compare-values 'equal "q" (sample-node-set "qff")) (compare-values 'equal (sample-node-set "qff") "q") (not (compare-values 'equal "qr" (sample-node-set "qff"))) (not (compare-values 'equal (sample-node-set "qff") "qr")) (compare-values '< 1 2) (not (compare-values '< 2 1)) (compare-values '<= 1 1) (not (compare-values '<= 2 1)) (compare-values '< "1" "2") (compare-values '< "1" 2) (not (compare-values '< 2 "1")) (compare-values '< nil t) (compare-values '> t nil) (compare-values '<= nil nil) (compare-values '>= nil nil) (compare-values '<= t t) (compare-values '>= t t) (not (compare-values '< t nil)) (not (compare-values '> nil t)) (compare-values '> (2values 1 2) (2values 1 2)) (compare-values '< (2values 1 2) (2values 1 2)) (compare-values '>= (2values 1 2) (2values 1 2)) (compare-values '<= (2values 1 2) (2values 1 2)) (not (compare-values '> (2values 1 2) (2values 3 4))) (not (compare-values '>= (2values 1 2) (2values 3 5))) (not (compare-values '< (2values 9 10) (2values 3 4))) (not (compare-values '<= (2values 9 10) (2values 3 4))) (compare-values 'equal t 4) (compare-values 'equal nil 0)))) (defmacro verify-xpath* (xml &rest items) (once-only (xml) (maybe-progn (loop for (expected . xpaths) in items append (loop for xpath in xpaths collect `(progn (format *debug-io* "~&testing: ~s -> ~s" ',xpath ',expected) (assert-equal ,expected (join-xpath-result (evaluate ,(if (stringp xpath) xpath `'(xpath ,xpath)) (make-context ,xml)))))))))) ;; TODO: test * and :text node tests; test returning multiple items; add other funcs; fix xf-equal (define-xpath-test test-xpath (with-namespaces () (verify-xpath* *sample-xml* ("zzz|||qqq" (:path (:descendant "a") (:attribute "href")) "descendant::a/attribute::href" "descendant::a/@href" "descendant::a/@href" "descendant::a[@href]/@href") ("another-value" (:path (:child "div") (:descendant * (= (:path (:attribute "class")) "another"))) "child::div/descendant::*[attribute::class='another']" "div/descendant::*[@class='another']") ("val1val2" (:path (:descendant "a" (= (:path (:attribute "href")) "zzz"))) "descendant::a[attribute::href='zzz']" "descendant::a[@href='zzz']") ("another-value" (:path (:child "div") (:child * (= (:path (:attribute "class")) "another"))) "child::div/child::*[attribute::class='another']" "div/*[@class='another']") ("val3" (:path (:descendant "a" (/= (:path (:attribute "href")) "zzz"))) "descendant::a[attribute::href != 'zzz']" "descendant::a[@href != 'zzz']") ("val1|||val3|||another-value" (:path (:descendant "span" (:or (= (:path (:attribute "class")) "sample") (= (:path (:attribute "class")) "another")))) "descendant::span[attribute::class='sample' or attribute::class='another']" "descendant::span[@class='sample' or @class='another']") ("42" (:path (:descendant "span" (:and (:path (:attribute "class")) (:not (:or (= (:path (:attribute "class")) "sample") (= (:path (:attribute "class")) "another")))))) "descendant::span[attribute::class and not(attribute::class='sample' or attribute::class='another')]" "descendant::span[@class and not(@class='sample' or @class='another')]") ("42" (:path (:child *) (:child * (:path (:child "hr")))) "child::*/child::*[child::hr]" "*/*[hr]") ("val3" (:path (:descendant "a" (= (:position) 2))) "descendant::a[position()=2]") ("42" (:path (:descendant "span" (= (:position) (:last)))) "descendant::span[position()=last()]") ("val1" (:path (:descendant "span" 1)) "descendant::span[1]") ("42" (:path (:descendant "span" (:last))) "descendant::span[last()]") ("true" (< 1 2) "1 < 2") ("false" (> 1 2) "1 > 2") ("true" (<= (:path (:child "div") (:child "span" (= (:path (:attribute "class")) "yetanother"))) 42) "div/span[@class='yetanother'] <= 42") ("false" (>= (:path (:child "div") (:child "span" (= (:path (:attribute "class")) "yetanother"))) 43) "div/span[@class='yetanother'] >= 43") ("5" (:count (:path (:descendant "span"))) "count(descendant::span)") ("val3" (:path (:child "div") (:child "a" (= (:count (:path (:child "span"))) 2))) "div/a[count(span)=2]") ("2" (:count (:path (:descendant * (= (:local-name) "a")))) "count(descendant::*[local-name()='a'])") ("span" (:local-name (:path (:descendant * (= (:path (:attribute "class")) "yetanother")))) "local-name(descendant::*[@class='yetanother'])") ("" (:local-name (:path (:descendant "font"))) "local-name(descendant::font)") ("class" (:local-name (:path (:descendant *) (:attribute "class"))) "local-name(descendant::*/@class)") ("abc42qqq-false" (:concat "abc" 42 "qqq-" (:false)) "concat('abc',42, 'qqq-', false())") ("false" (:false) "false()") ("true" (:true) "true()") ("false" (:boolean "") "boolean('')") ("true" (:boolean "aa") "boolean('aa')") ("42" (+ (:number "20") 22) "number('20') + 22") ;; test string(x) ("val1val2|||val3" (:path (:descendant "a")) "descendant::a") ("val1val2" (:string (:path (:descendant "a"))) "string(descendant::a)") ("true" (:contains "needle-in-haystack" "needle") "contains('needle-in-haystack', 'needle')") ("1999" (:substring-before "1999/04/01" "/") "substring-before('1999/04/01', '/')") ("04/01" (:substring-after "1999/04/01" "/") "substring-after('1999/04/01', '/')") ("99/04/01" (:substring-after "1999/04/01" "19") "substring-after('1999/04/01', '19')") ("3" (:string-length "abc") "string-length('abc')") ("42" (:path (:descendant * (> (:path (:self *)) 41))) "descendant::*[.>41]") ("42" (* 2 (+ (- 100 90) 11)) "2 * (100 - 90 + 11)") ("def" (:substring "abcdef" 4) "substring('abcdef', 4)") ("abc" (:substring "abcdef" 1 3) "substring('abcdef', 1, 3)") ("abc" (:substring "abcdef" 0 4) "substring('abcdef', 0, 4)") ("234" "substring('12345', 1.5, 2.6)") ("12" "substring('12345', 0, 3)") ("" "substring('12345', 0 div 0, 3)") ("" "substring('12345', 1, 0 div 0)") ("12345" "substring('12345', -42, 1 div 0)") ("" "substring('12345', -1 div 0, 1 div 0)") ("" "normalize-space('')" "normalize-space(' ')") ("abc def" "normalize-space('abc def')" "normalize-space(' abc def')" "normalize-space(' abc def ')") ("47" "sum(//span[@id='s5']|//h4)") ("0" "sum(//span[.!=.])") ("NaN" "sum(//span)") ("" "concat(local-name(//text()[1]), name(//text()[1]), namespace-uri(//text()[1]))") ("true" "true() = 4" (= (:true) 4))) (verify-xpath* *sample-xml-3* ("W" (:id "w") "id('w')") ("X" (:id "x") "id('x')") ("Y" (:id "y") "id('y')") ("Z" (:id "z") "id('z')") ("W|||X|||Y|||Z" (:id "z y w x") "id('z y w x')") ("W|||Y|||Z" (:id " z y w ") "id(' z y w ')") ("a" (:local-name (:id "w")) "local-name(id('w'))") ("W|||X|||Y" (:id (:path (:child "main") (:child "b"))) "id(main/b)")))) (define-xpath-test test-with-namespaces-0 ;empty namespace need not be declared (eq (first-node (evaluate "/div" *sample-xml*)) (funcall *document-element* *sample-xml*))) (define-xpath-test test-with-namespaces-1 (with-namespaces (("" "")) ;can declare empty namespace (eq (first-node (evaluate "/div" *sample-xml*)) (funcall *document-element* *sample-xml*)))) (define-xpath-test test-with-namespaces-2 (with-namespaces (("foo" "http://special")) (eql 1 (length (all-nodes (evaluate "//foo:a" *sample-xml-2*)))))) (define-xpath-test test-with-namespaces-3 (with-namespaces (("foo" "http://special")) (eql 2 (length (all-nodes (evaluate "//foo:*" *sample-xml-2*)))))) (define-xpath-test test-with-namespaces-4 (handler-case (funcall (compile nil `(lambda () (with-namespaces (("foo" "http://special")) (evaluate "//bar:*" *sample-xml-2*))))) (error () t) (:no-error (x) (error "test failed with return value ~A" x)))) (define-xpath-test test-with-variables-1 (with-namespaces (("" "")) (with-variables (("foo" 3)) (eql (number-value (evaluate "$foo" *sample-xml*)) 3)))) (define-xpath-test test-with-variables-2 (with-namespaces (("" "") ("ns" "http://foo")) (with-variables (("foo" 2) ("ns:foo" 3)) (eql (number-value (evaluate "$foo + $ns:foo" *sample-xml*)) 5)))) (define-xpath-test test-with-variables-3 (handler-case (funcall (compile nil `(lambda () (with-namespaces (("" "")) (with-variables (("foo" 2) ("ns:foo" 3)) (evaluate "$foo" *sample-xml*)))))) (error () t) (:no-error (x) (error "test failed with return value ~A" x)))) (define-xpath-test test-computed-with-variables (with-namespaces (("" "")) (with-variables (("foo" (* 3 5))) (eql (number-value (evaluate "$foo" *sample-xml*)) 15)))) (define-xpath-test test-eager-with-variable-evaluation (let ((n 0)) (with-namespaces (("" "")) (with-variables (("foo" (incf n))) (evaluate "$foo" *sample-xml*))) (assert-equal n 1))) (define-xpath-test test-following (xpath:with-namespaces (("" "")) (assert-equal* 0 (xpath:evaluate "count(html/following::text())" (cxml:parse-rod "" *dom-builder*)) 11.0d0 (xpath:evaluate "count(//following::div) * 10 + count(//div|body/div)" (cxml:parse-rod "
" *dom-builder*))))) (define-xpath-test test-filtering (with-namespaces (("" "")) (with-variables (("somevar" (evaluate "/div" *sample-xml*))) (assert-equal "another-value" (evaluate "string($somevar/span[@class='another'])" *sample-xml*))))) (define-xpath-test test-node-set-api (labels ((join (list) (format nil "~{~a~^|||~}" list)) (verify-results (expected-str xml) (let ((node-set (sample-node-set xml))) (assert-equal* expected-str (join (mapcar #'get-node-text (force (pipe-of node-set)))) expected-str (join (map-node-set->list #'get-node-text node-set)) expected-str (let ((l '())) (assert-equal nil (map-node-set #'(lambda (node) (push (get-node-text node) l)) node-set)) (join (nreverse l))) expected-str (let ((l '())) (do-node-set (node node-set (join (nreverse l))) (push (get-node-text node) l))) expected-str (let ((l '())) (assert-equal nil (do-node-set (node node-set) (push (get-node-text node) l))) (join (nreverse l))) expected-str (join (loop for iter = (make-node-set-iterator node-set) then (node-set-iterator-next iter) while (not (node-set-iterator-end-p iter)) collect (get-node-text (node-set-iterator-current iter)))))))) (verify-results "" "") (verify-results "test" "test") (verify-results "test1|||test2" "test1
test2
") (verify-results "test1|||test2|||test3" "test1
test2

test3

") (verify-results "test1|||test2|||test3|||test4" "test1
test2

test3

test4

"))) (define-xpath-test test-plx-extensions (with-plx-extensions (verify-xpath* *sample-xml* ("another-value|||42" (:path (:descendant "span" ((:qfunc "plx" "matches") (:path (:attribute "class")) "other$"))) "descendant::span[plx:matches(@class, 'other$')]" "descendant::span[plx:matches(@class, 'OTHER$', 'i')]") ("another-value" ;; make sure compiled regex caching doesn't break anything "descendant::span[plx:matches('another', concat('^', @class, '$'))]") ("" "descendant::span[plx:matches(@class, 'OTHER$')]") ("def--abc" "plx:replace('abc--def', '(a.*)--(d.*)', '\\2--\\1')" "plx:replace('abc--def', '(A.*)--(D.*)', '\\2--\\1', 'i')") ("true" (= ((:qfunc "plx" "current")) (:path (:root :node))) "plx:current() = /") ("another-value" "//span[@class='another' and plx:current()/div/@class = 'something']" "//span[@class='another' and plx:current() = /]") ("true" "plx:generate-id(//span[1]) = plx:generate-id(//span[@class='sample'])" "plx:generate-id(//span) = plx:generate-id(//span[@class='sample'])" "plx:generate-id(//span[2]) != plx:generate-id(//span[@class='sample'])" "plx:generate-id(//span[2]) != plx:generate-id(/)" "plx:generate-id() = plx:generate-id(/)")))) (define-xpath-test test-pattern-case (flet ((check (expected-value expression) (let* ((node (first-node (evaluate expression *sample-xml*))) (actual-value (pattern-case node ("div" :div) ("span[@class='another']" :another) ("*" :element) (t :otherwise)))) (unless (eql expected-value actual-value) (error "expected ~A but got ~A for ~A" expected-value actual-value expression))))) (check :div "//div") (check :element "//span") (check :another "(//span)[4]") (check :otherwise "//span/@class"))) (define-xpath-test test-node-matches-p (flet ((check (expected match select &optional (document *sample-xml*)) (let* ((node (first-node (evaluate select document))) (actual (node-matches-p node match))) (unless (eql expected actual) (error "expected ~A but got ~A for ~A on ~A" expected actual match node))))) (check t "div" "//div") (check t "//div" "//div") (check t "*" "//span") (check t "span[@class='another']" "(//span)[4]") (check t "@*" "//span/@class") (check t "a//c" "/doc/a/e/b/c" *sample-xml-4*) (check t "//a//c" "/doc/a/e/b/c" *sample-xml-4*) (check t "B//X" "/doc/A/X/B/X/C/X" *sample-xml-4*) (check t "B//X" "/doc/A/X/B/X" *sample-xml-4*) (check t "X//X" "/doc/A/X/B/X" *sample-xml-4*) (check nil "B//B" "/doc/A/X/B" *sample-xml-4*) (check nil "span[@class='another']" "//span") (check nil "div" "//span") (check nil "*" "//span/@class"))) (deftest test-xmls (let ((*navigator* (cxml-xmls:make-xpath-navigator)) (d '("foo" (("a" "b")) " " ("a" (("id" "1"))) " " ("b" (("id" "2"))) " " ("c" (("id" "3"))) " " ("a" (("id" "4"))) " " ("b" (("id" "5"))) " " ("c" (("id" "6"))) " " ("a" (("id" "7"))) " " ("b" (("id" "8"))) " " ("c" (("id" "9"))) " " ("last" NIL)))) (assert-equal '(("a" (("id" "1"))) ("c" (("id" "6")))) (all-nodes (evaluate "//c[position()=2]|//a[@id='1']" d)))))