From 41e7f73036a4c08ea2203dcd2219ec09ad30b965 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 23 Oct 2023 02:08:15 +0200 Subject: Split webdav tests into more files. --- tests/unit/webdav/webdav-property.scm | 58 ++++++ tests/unit/webdav/webdav-propfind.scm | 232 ++++++++++++++++++++++++ tests/unit/webdav/webdav-resource.scm | 83 ++++++++- tests/unit/webdav/webdav.scm | 331 +--------------------------------- 4 files changed, 372 insertions(+), 332 deletions(-) create mode 100644 tests/unit/webdav/webdav-property.scm create mode 100644 tests/unit/webdav/webdav-propfind.scm (limited to 'tests/unit') diff --git a/tests/unit/webdav/webdav-property.scm b/tests/unit/webdav/webdav-property.scm new file mode 100644 index 00000000..0b465e82 --- /dev/null +++ b/tests/unit/webdav/webdav-property.scm @@ -0,0 +1,58 @@ +(define-module (test webdav-property) + :use-module ((calp namespaces) :select (webdav)) + :use-module ((calp webdav property) + :select (propstat merge-propstats propstat->namespaced-sxml)) + :use-module (calp webdav resource) + :use-module (calp webdav resource virtual) + :use-module (datetime) + :use-module (oop goops) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (sxml namespaced) + ) + +(define dt + (datetime year: 2010 month: 11 day: 12 + hour: 13 minute: 14 hour: 15)) + +(define resource (make + ;; local-path: '("") + name: "*root" + content: #vu8(1 2 3 4) + creation-time: dt)) + + + +;; (test-equal "/" (href->string (href resource))) +(test-equal "Basic propstat" + (propstat 200 (list (list (xml webdav 'getcontentlength) 4))) + (getcontentlength resource)) + + +;;; NOTE propstat's return order isn't stable, making this test possibly fail +(let ((ps (list (propstat 200 (list `(,(xml webdav 'displayname) "Displayname"))) + (propstat 200 (list `(,(xml webdav 'getcontenttype) "text/plain")))))) + (test-equal "Propstat merger" + (list (propstat 200 + (list (list (xml webdav 'getcontenttype) "text/plain") + (list (xml webdav 'displayname) "Displayname")))) + (merge-propstats ps))) + +(test-group "Propstat -> namespaced sxml" + (test-equal "Simple" + `(,(xml webdav 'propstat) + (,(xml webdav 'prop) (,(xml webdav 'displayname) "test")) + (,(xml webdav 'status) "HTTP/1.1 200 OK")) + (propstat->namespaced-sxml (propstat 200 `((,(xml webdav 'displayname) "test")) ))) + + ;; TODO populated error field + + (test-equal "With response description" + `(,(xml webdav 'propstat) + (,(xml webdav 'prop) (,(xml webdav 'displayname) "test")) + (,(xml webdav 'status) "HTTP/1.1 403 Forbidden") + (,(xml webdav 'responsedescription) "Try logging in")) + (propstat->namespaced-sxml (propstat 403 `((,(xml webdav 'displayname) "test")) + responsedescription: "Try logging in")))) + +'((calp webdav property)) diff --git a/tests/unit/webdav/webdav-propfind.scm b/tests/unit/webdav/webdav-propfind.scm new file mode 100644 index 00000000..74511419 --- /dev/null +++ b/tests/unit/webdav/webdav-propfind.scm @@ -0,0 +1,232 @@ +(define-module (test webdav-propfind) + :use-module ((hnh util) :select (sort*)) + :use-module ((calp namespaces) :select (webdav)) + :use-module (calp webdav property) + :use-module (calp webdav propfind) + :use-module (calp webdav resource virtual) + :use-module (datetime) + :use-module (oop goops) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (sxml namespaced) + ) + + +(define (sort-symbols symbs) + (sort* symbs string<=? symbol->string)) + +(define (sort-propstats propstats) + (map + (lambda (propstat) + (make-propstat (propstat-status-code propstat) + (sort* (propstat-property propstat) + string< (compose symbol->string xml-element-tagname car)) + (propstat-error propstat) + (propstat-response-description propstat))) + (sort* propstats < propstat-status-code))) + + + +(define dt #2010-11-12T13:14:15) + +(define resource (make + ;; local-path: '("") + name: "*root" + content: #vu8(1 2 3 4) + creation-time: dt)) + +(define ns1 (string->symbol "http://example.com/namespace")) + + + +(test-group "\"All\" live properties" + (let ((most (propfind-most-live-properties resource))) + (test-equal "Correct amount of keys" 10 (length most)) + (for-each (lambda (propstat) + (test-assert "Propstat is propstat" (propstat? propstat)) + (test-equal (format #f "Propstat well formed: ~a" (propstat-property propstat)) + 1 (length (propstat-property propstat))) + (test-assert "Propstat child is xml" + (xml-element? (caar (propstat-property propstat))))) + most) + + (test-equal "Correct keys" + '(creationdate displayname getcontentlanguage getcontentlength + getcontenttype getetag getlastmodified + lockdiscovery resourcetype supportedlock) + (sort-symbols (map (compose xml-element-tagname caar propstat-property) most))))) + + +(test-equal "propfind-selected-properties" + (list (propstat 404 `((,(xml webdav 'displayname))))) + (propfind-selected-properties resource (list (xml webdav 'displayname)))) + +(test-group "parse-propfind" + (test-group "propname" + (let ((props (parse-propfind `(,(xml webdav 'propfind) + (,(xml webdav 'propname))) + resource))) + + + (test-group "Propfind should NEVER fail for an existing resource" + (test-equal 1 (length props)) + (test-equal 200 (propstat-status-code (car props)))) + + (test-assert "Propstat objects are returned" (propstat? (car props))) + (for-each (lambda (el) + (test-assert "Base is list" (list? el)) + (test-eqv "List only contains head el" 1 (length el)) + #; + (test-assert (format #f "Head is an xml tag: ~a" el) + (xml-element? (car el)))) + (propstat-property (car props))) + + #; + (test-equal "Correct property keys" + (sort-symbols (cons* 'test 'is-virtual webdav-keys)) + (sort-symbols (map (compose xml-element-tagname car) + (propstat-property (car props))))) + + (test-group "No property should contain any data" + (for-each (lambda (el) + (test-eqv (format #f "Propname property: ~s" el) + 1 (length el))) + (propstat-property (car props)))))) + + + (test-group "direct property list" + (let ((props (parse-propfind `((xml webdav 'propfind) + (,(xml webdav 'prop) + (,(xml webdav 'displayname)))) + resource))) + (test-equal "Simple lookup" + (list (propstat 404 (list (list (xml webdav 'displayname) + )))) + props))) + + ;; TODO test that calendar properties are reported by propname + ;; TODO test that non-native caldav propreties aren't reported by allprop + + (test-group "allprop" + (let ((props (parse-propfind `(,(xml webdav 'propfind) + (,(xml webdav 'allprop))) + resource))) + + + (test-equal "Propfind result" + (list + (propstat 200 + (list (list (xml webdav 'creationdate) + (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) + (list (xml webdav 'getcontentlength) + 4) + (list (xml webdav 'getcontenttype) + "application/binary") + (list (xml webdav 'getlastmodified) + "Thu, 01 Jan 1970 00:00:00 GMT") + (list (xml webdav 'lockdiscovery) '()) + (list (xml webdav 'resourcetype) + ; (list (xml webdav 'collection)) + ) + (list (xml webdav 'supportedlock) '()) + ;; (list (xml ns1 'test) "Content") + )) + (propstat 404 (list (list (xml webdav 'displayname)) + (list (xml webdav 'getcontentlanguage)))) + (propstat 501 + (list (list (xml webdav 'getetag)) + ))) + (sort-propstats props)))) + + + (test-group "allprop with include" + (let ((props (parse-propfind `((xml webdav 'propfind) + (,(xml webdav 'allprop)) + (,(xml webdav 'include))) + resource))) + + + (test-equal "Include NOTHING" + (list + (propstat 200 + (list (list (xml webdav 'creationdate) + (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) + (list (xml webdav 'getcontentlength) + 4) + (list (xml webdav 'getcontenttype) + "application/binary") + (list (xml webdav 'getlastmodified) + "Thu, 01 Jan 1970 00:00:00 GMT") + (list (xml webdav 'lockdiscovery) '()) + (list (xml webdav 'resourcetype) + ; (list (xml webdav 'collection)) + ) + (list (xml webdav 'supportedlock) '()) + ;; (list (xml ns1 'test) "Content") + )) + (propstat 404 (list (list (xml webdav 'displayname)) + (list (xml webdav 'getcontentlanguage)))) + (propstat 501 + (list (list (xml webdav 'getetag)) + ))) + (sort-propstats props))) + + + (let ((props (parse-propfind `(,(xml webdav 'propfind) + (,(xml webdav 'allprop)) + (,(xml webdav 'include) + (,(xml virtual-ns 'isvirtual)))) + resource))) + + (test-equal "Include isvirtual" + (list + (propstat 200 + (list (list (xml webdav 'creationdate) (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) + (list (xml webdav 'getcontentlength) 4) + (list (xml webdav 'getcontenttype) "application/binary") + (list (xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT") + (list (xml virtual-ns 'isvirtual) "true") + (list (xml webdav 'lockdiscovery) '()) + (list (xml webdav 'resourcetype)) + (list (xml webdav 'supportedlock) '()) + ;; (list (xml ns1 'test) "Content") + )) + (propstat 404 (list (list (xml webdav 'displayname)) + (list (xml webdav 'getcontentlanguage)))) + (propstat 501 + (list (list (xml webdav 'getetag)) + ))) + (sort-propstats props))))) + + +(test-equal + (list (propstat 200 + `((,(xml webdav 'getcontentlength) 4) + (,(xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT") + (,(xml webdav 'resourcetype)))) + (propstat 404 + `((,(xml webdav 'checked-in)) + (,(xml webdav 'checked-out)) + (,(xml (string->symbol "http://apache.org/dav/props/") 'executable))))) + (let ((request (xml->namespaced-sxml + " + + + + + + + + + +"))) + + (sort-propstats (parse-propfind (caddr request) resource)))) + +(test-equal "All dead properties" + (list #; + (propstat 200 (list (list (xml ns1 'test) "Content") ; + ))) + (propfind-all-dead-properties resource)) + +'((calp webdav propfind)) diff --git a/tests/unit/webdav/webdav-resource.scm b/tests/unit/webdav/webdav-resource.scm index 73a434be..f6ebf3bb 100644 --- a/tests/unit/webdav/webdav-resource.scm +++ b/tests/unit/webdav/webdav-resource.scm @@ -1,9 +1,29 @@ (define-module (test webdav-resource) + :use-module ((calp namespaces) :select (webdav)) + :use-module ((calp webdav property) :select (propstat)) + :use-module (calp webdav resource base) + :use-module (calp webdav resource virtual) + :use-module (calp webdav resource) + :use-module (datetime) + :use-module (oop goops) :use-module (srfi srfi-64) :use-module (srfi srfi-64 test-error) :use-module (srfi srfi-71) :use-module (srfi srfi-88) - :use-module (calp webdav resource base)) + :use-module (sxml namespaced) + ) + +(define dt + (datetime year: 2010 month: 11 day: 12 + hour: 13 minute: 14 hour: 15)) + +(define resource (make + ;; local-path: '("") + name: "*root" + content: #vu8(1 2 3 4) + creation-time: dt)) + + (test-group "string->href" (test-equal "Root path becomes null" @@ -28,4 +48,63 @@ (test-error 'misc-error (href-relative '("c") '()))) -'((calp webdav resource base)) +(test-group "All live properties" + (let ((props (live-properties resource))) + (test-assert (list? props)) + (for-each (lambda (pair) + ;; (test-assert (xml-element? (car pair))) + (test-assert (live-property? (cdr pair))) + (test-assert (procedure? (property-getter (cdr pair)))) + (test-assert (procedure? (property-setter-generator (cdr pair))))) + props))) + + +(define ns1 (string->symbol "http://example.com/namespace")) + +(set-dead-property! resource `(,(xml ns1 'test) "Content")) + +(test-equal "Get dead property" + (propstat 200 (list (list (xml ns1 'test) "Content"))) + (get-dead-property resource (xml ns1 'test))) + +(test-equal "Get live property" + (propstat 404 (list (list (xml ns1 'test)))) + (get-live-property resource (xml ns1 'test))) + +(test-group "Dead properties" + (test-equal "Existing property" + (propstat 200 (list (list (xml ns1 'test) "Content"))) + (get-property resource (xml ns1 'test))) + + (test-equal "Missing property" + (propstat 404 (list (list (xml ns1 'test2)))) + (get-property resource (xml ns1 'test2)))) + +(test-group "Live Properties" + + ;; TODO these tests were written when displayname always returned 200, but have since changed to test for 404. + ;; Change to another property which return 200 + (test-equal "Existing live property (through get-live-property)" + (propstat 404 `((,(xml webdav 'displayname)))) + (get-live-property resource (xml webdav 'displayname))) + + (test-equal "Existing live property (thrtough get-property)" + (propstat 404 `((,(xml webdav 'displayname)))) + (get-property resource (xml webdav 'displayname)))) + +(test-group "lookup-resource" + (let* ((root (make name: "*root*")) + (a (add-collection! root "a")) + (b (add-collection! a "b")) + (c (add-resource! b "c" "~~Nothing~~"))) + (test-eq "Lookup root" + root (lookup-resource root '())) + (test-eq "Lookup direct child" + a (lookup-resource root '("a"))) + (test-eq "Lookup deep child" + c (lookup-resource root '("a" "b" "c"))) + (test-assert "Lookup missing" + (not (lookup-resource root '("a" "d" "c")))))) + +'((calp webdav resource) + (calp webdav resource base)) diff --git a/tests/unit/webdav/webdav.scm b/tests/unit/webdav/webdav.scm index e86b5342..4fb816c2 100644 --- a/tests/unit/webdav/webdav.scm +++ b/tests/unit/webdav/webdav.scm @@ -3,14 +3,11 @@ :use-module (srfi srfi-71) :use-module (srfi srfi-88) :use-module (srfi srfi-1) - :use-module (sxml namespaced) :use-module (oop goops) :use-module (calp namespaces) - :use-module ((hnh util) :select (sort*)) :use-module (datetime) :use-module (calp webdav property) - :use-module (calp webdav propfind) :use-module (calp webdav resource) :use-module (calp webdav resource virtual) ) @@ -21,339 +18,13 @@ ;;; TODO tests for a missing resource? -(define (swap p) (xcons (car p) (cdr p))) - -(define dt #2010-11-12T13:14:15) - -(define resource (make - ;; local-path: '("") - name: "*root" - content: #vu8(1 2 3 4) - creation-time: dt)) - -(define (sort-propstats propstats) - (map - (lambda (propstat) - (make-propstat (propstat-status-code propstat) - (sort* (propstat-property propstat) - string< (compose symbol->string xml-element-tagname car)) - (propstat-error propstat) - (propstat-response-description propstat))) - (sort* propstats < propstat-status-code)) - ) - -;; (test-equal "/" (href->string (href resource))) -(test-equal "Basic propstat" - (propstat 200 (list (list (xml webdav 'getcontentlength) 4))) - (getcontentlength resource)) - - -(define (sort-symbols symbs) - (sort* symbs string<=? symbol->string)) - - - -;;; NOTE propstat's return order isn't stable, making this test possibly fail -(let ((ps (list (propstat 200 (list `(,(xml webdav 'displayname) "Displayname"))) - (propstat 200 (list `(,(xml webdav 'getcontenttype) "text/plain")))))) - (test-equal "Propstat merger" - (list (propstat 200 - (list (list (xml webdav 'getcontenttype) "text/plain") - (list (xml webdav 'displayname) "Displayname")))) - (merge-propstats ps))) - - - -(test-group "All live properties" - (let ((props (live-properties resource))) - (test-assert (list? props)) - (for-each (lambda (pair) - ;; (test-assert (xml-element? (car pair))) - (test-assert (live-property? (cdr pair))) - (test-assert (procedure? (property-getter (cdr pair)))) - (test-assert (procedure? (property-setter-generator (cdr pair))))) - props))) - -(test-group "\"All\" live properties" - (let ((most (propfind-most-live-properties resource))) - (test-equal "Correct amount of keys" 10 (length most)) - (for-each (lambda (propstat) - (test-assert "Propstat is propstat" (propstat? propstat)) - (test-equal (format #f "Propstat well formed: ~a" (propstat-property propstat)) - 1 (length (propstat-property propstat))) - (test-assert "Propstat child is xml" - (xml-element? (caar (propstat-property propstat))))) - most) - - (test-equal "Correct keys" - '(creationdate displayname getcontentlanguage getcontentlength - getcontenttype getetag getlastmodified - lockdiscovery resourcetype supportedlock) - (sort-symbols (map (compose xml-element-tagname caar propstat-property) most))))) - - - -(define ns1 (string->symbol "http://example.com/namespace")) - -(set-dead-property! resource `(,(xml ns1 'test) "Content")) - -(test-equal "Get dead property" - (propstat 200 (list (list (xml ns1 'test) "Content"))) - (get-dead-property resource (xml ns1 'test))) - -(test-equal "Get live property" - (propstat 404 (list (list (xml ns1 'test)))) - (get-live-property resource (xml ns1 'test))) - -(test-group "Dead properties" - (test-equal "Existing property" - (propstat 200 (list (list (xml ns1 'test) "Content"))) - (get-property resource (xml ns1 'test))) - - (test-equal "Missing property" - (propstat 404 (list (list (xml ns1 'test2)))) - (get-property resource (xml ns1 'test2))) - - (test-equal "All dead properties" - (list (propstat 200 (list (list (xml ns1 'test) "Content")))) - (propfind-all-dead-properties resource))) - -(test-group "Live Properties" - - ;; TODO these tests were written when displayname always returned 200, but have since changed to test for 404. - ;; Change to another property which return 200 - (test-equal "Existing live property (through get-live-property)" - (propstat 404 `((,(xml webdav 'displayname)))) - (get-live-property resource (xml webdav 'displayname))) - - (test-equal "Existing live property (thrtough get-property)" - (propstat 404 `((,(xml webdav 'displayname)))) - (get-property resource (xml webdav 'displayname))) - ) - -(test-equal "propfind-selected-properties" - (list (propstat 404 `((,(xml webdav 'displayname))))) - (propfind-selected-properties resource (list (xml webdav 'displayname)))) - -(test-group "parse-propfind" - (test-group "propname" - (let ((props (parse-propfind `(,(xml webdav 'propfind) - (,(xml webdav 'propname))) - resource))) - - - (test-group "Propfind should NEVER fail for an existing resource" - (test-equal 1 (length props)) - (test-equal 200 (propstat-status-code (car props)))) - - (test-assert "Propstat objects are returned" (propstat? (car props))) - (for-each (lambda (el) - (test-assert "Base is list" (list? el)) - (test-eqv "List only contains head el" 1 (length el)) - #; - (test-assert (format #f "Head is an xml tag: ~a" el) - (xml-element? (car el)))) - (propstat-property (car props))) - - #; - (test-equal "Correct property keys" - (sort-symbols (cons* 'test 'is-virtual webdav-keys)) - (sort-symbols (map (compose xml-element-tagname car) - (propstat-property (car props))))) - - (test-group "No property should contain any data" - (for-each (lambda (el) - (test-eqv (format #f "Propname property: ~s" el) - 1 (length el))) - (propstat-property (car props)))))) - - - (test-group "direct property list" - (let ((props (parse-propfind `((xml webdav 'propfind) - (,(xml webdav 'prop) - (,(xml webdav 'displayname)))) - resource))) - (test-equal "Simple lookup" - (list (propstat 404 (list (list (xml webdav 'displayname) - )))) - props))) - - ;; TODO test that calendar properties are reported by propname - ;; TODO test that non-native caldav propreties aren't reported by allprop - - (test-group "allprop" - (let ((props (parse-propfind `(,(xml webdav 'propfind) - (,(xml webdav 'allprop))) - resource))) - - - (test-equal "Propfind result" - (list - (propstat 200 - (list (list (xml webdav 'creationdate) - (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) - (list (xml webdav 'getcontentlength) - 4) - (list (xml webdav 'getcontenttype) - "application/binary") - (list (xml webdav 'getlastmodified) - "Thu, 01 Jan 1970 00:00:00 GMT") - (list (xml webdav 'lockdiscovery) '()) - (list (xml webdav 'resourcetype) - ; (list (xml webdav 'collection)) - ) - (list (xml webdav 'supportedlock) '()) - (list (xml ns1 'test) "Content") - )) - (propstat 404 (list (list (xml webdav 'displayname)) - (list (xml webdav 'getcontentlanguage)))) - (propstat 501 - (list (list (xml webdav 'getetag)) - ))) - (sort-propstats props)))) - - - (test-group "allprop with include" - (let ((props (parse-propfind `((xml webdav 'propfind) - (,(xml webdav 'allprop)) - (,(xml webdav 'include))) - resource))) - - - (test-equal "Include NOTHING" - (list - (propstat 200 - (list (list (xml webdav 'creationdate) - (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) - (list (xml webdav 'getcontentlength) - 4) - (list (xml webdav 'getcontenttype) - "application/binary") - (list (xml webdav 'getlastmodified) - "Thu, 01 Jan 1970 00:00:00 GMT") - (list (xml webdav 'lockdiscovery) '()) - (list (xml webdav 'resourcetype) - ; (list (xml webdav 'collection)) - ) - (list (xml webdav 'supportedlock) '()) - (list (xml ns1 'test) "Content") - )) - (propstat 404 (list (list (xml webdav 'displayname)) - (list (xml webdav 'getcontentlanguage)))) - (propstat 501 - (list (list (xml webdav 'getetag)) - ))) - (sort-propstats props))) - - - (let ((props (parse-propfind `(,(xml webdav 'propfind) - (,(xml webdav 'allprop)) - (,(xml webdav 'include) - (,(xml virtual-ns 'isvirtual)))) - resource))) - - (test-equal "Include isvirtual" - (list - (propstat 200 - (list (list (xml webdav 'creationdate) (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) - (list (xml webdav 'getcontentlength) 4) - (list (xml webdav 'getcontenttype) "application/binary") - (list (xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT") - (list (xml virtual-ns 'isvirtual) "true") - (list (xml webdav 'lockdiscovery) '()) - (list (xml webdav 'resourcetype)) - (list (xml webdav 'supportedlock) '()) - (list (xml ns1 'test) "Content") - )) - (propstat 404 (list (list (xml webdav 'displayname)) - (list (xml webdav 'getcontentlanguage)))) - (propstat 501 - (list (list (xml webdav 'getetag)) - ))) - (sort-propstats props))))) - - - - -;;; Setting properties - -;;; We already use set-dead-property! above, but for testing get we need set, -;;; and for testing set we need get, and get is more independent, so we start there. - - - -(test-group "Propstat -> namespaced sxml" - (test-equal "Simple" - `(,(xml webdav 'propstat) - (,(xml webdav 'prop) (,(xml webdav 'displayname) "test")) - (,(xml webdav 'status) "HTTP/1.1 200 OK")) - (propstat->namespaced-sxml (propstat 200 `((,(xml webdav 'displayname) "test")) ))) - - ;; TODO populated error field - - (test-equal "With response description" - `(,(xml webdav 'propstat) - (,(xml webdav 'prop) (,(xml webdav 'displayname) "test")) - (,(xml webdav 'status) "HTTP/1.1 403 Forbidden") - (,(xml webdav 'responsedescription) "Try logging in")) - (propstat->namespaced-sxml (propstat 403 `((,(xml webdav 'displayname) "test")) - responsedescription: "Try logging in")))) ;;; TODO what am I doing here? -(test-equal - (list (propstat 200 - `((,(xml webdav 'getcontentlength) 4) - (,(xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT") - (,(xml webdav 'resourcetype)))) - (propstat 404 - `((,(xml webdav 'checked-in)) - (,(xml webdav 'checked-out)) - (,(xml (string->symbol "http://apache.org/dav/props/") 'executable))))) - (let ((request (xml->namespaced-sxml - " - - - - - - - - - -"))) - - (sort-propstats (parse-propfind (caddr request) resource)))) - - - -(test-group "lookup-resource" - (let* ((root (make name: "*root*")) - (a (add-collection! root "a")) - (b (add-collection! a "b")) - (c (add-resource! b "c" "~~Nothing~~"))) - (test-eq "Lookup root" - root (lookup-resource root '())) - (test-eq "Lookup direct child" - a (lookup-resource root '("a"))) - (test-eq "Lookup deep child" - c (lookup-resource root '("a" "b" "c"))) - (test-assert "Lookup missing" - (not (lookup-resource root '("a" "d" "c")))))) - -(test-group "mkcol" - (let ((root (make name: "*root*"))) - (add-collection! root "child") - (test-eqv "Child got added" 1 (length (children root))))) - - -'((calp webdav property) - (calp webdav propfind) - (calp webdav resource) - (calp webdav resource virtual)) +'((calp webdav resource virtual)) -- cgit v1.2.3