Tests: Use test buffer for link safety tests

This commit is contained in:
Adam Porter 2020-11-13 02:42:52 -06:00
parent 56647d4b11
commit b90e6e25d0

View file

@ -1172,79 +1172,87 @@ RESULTS should be a list of strings as returned by
(require 'org-ql-search) (require 'org-ql-search)
(require 'org-ql-view) (require 'org-ql-view)
(cl-flet ((open-link ;; The :auto-map test requires there to be results (because the org-super-agenda :auto-map group's
(link) (with-temp-buffer ;; key-form, where the safety check is, only gets evaluated when there are results). Using
(org-mode) ;; `with-temp-buffer' in the `open-link' function causes the temp buffer to be killed before the results
(insert link) ;; have a chance to be gathered. So we make a test buffer and run the test in that, with a test heading.
(backward-char 1)
(call-interactively #'org-open-at-point))))
(it "buffers-files parameter" (let ((test-buffer (get-buffer-create "*test-org-ql*")))
(let ((quoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") (cl-flet ((open-link
(unquoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") (link) (with-current-buffer test-buffer
(quoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28quote%20%28lambda%20nil%20%28message%20%22AHA%22%29%29%29%29]]") (erase-buffer)
(unquoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28lambda%20nil%20%28message%20%22AHA%22%29%29%29]]")) (org-mode)
(expect (open-link quoted-lambda-link) (insert "* TODO Test heading \n\n")
:to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA")))) (insert link)
(expect (open-link unquoted-lambda-link) (backward-char 1)
:to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA")))) (call-interactively #'org-open-at-point))))
(expect (open-link quoted-lambda-in-list-link)
:to-throw 'wrong-type-argument '(stringp ((quote (lambda nil (message "AHA"))))))
(expect (open-link unquoted-lambda-in-list-link)
:to-throw 'wrong-type-argument '(stringp ((lambda nil (message "AHA")))))))
(it "super-groups parameter" (it "buffers-files parameter"
(let ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") (let ((quoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]")
(unquoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]") (unquoted-lambda-link "[[org-ql-search:todo:?buffers-files%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]")
(quoted-expression-link "[[org-ql-search:todo:?super-groups%3D%28message%20%22AHA%22%29]]") (quoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28quote%20%28lambda%20nil%20%28message%20%22AHA%22%29%29%29%29]]")
(unquoted-expression-link "[[org-ql-search:todo:?super-groups%3D%22AHA%22]]") (unquoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28lambda%20nil%20%28message%20%22AHA%22%29%29%29]]"))
(pred-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Apred%20%28lambda%20%28_%29%20%28message%20%22AHA%22%29%29%29%29]]") (expect (open-link quoted-lambda-link)
(auto-map-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Aauto-map%20%28lambda%20%28_%29%20%28message%20%22AHA%22%29%29%29%29]]")) :to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA"))))
(expect (open-link quoted-lambda-link) (expect (open-link unquoted-lambda-link)
:to-throw 'wrong-type-argument '(listp lambda)) :to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA"))))
(expect (open-link unquoted-lambda-link) (expect (open-link quoted-lambda-in-list-link)
:to-throw 'wrong-type-argument '(listp lambda)) :to-throw 'wrong-type-argument '(stringp ((quote (lambda nil (message "AHA"))))))
(expect (open-link quoted-expression-link) (expect (open-link unquoted-lambda-in-list-link)
:to-throw 'wrong-type-argument '(listp message)) :to-throw 'wrong-type-argument '(stringp ((lambda nil (message "AHA")))))))
(expect (open-link unquoted-expression-link)
:to-throw 'error '("cl-etypecase failed: AHA, (symbol list)"))
;; FIXME: These two tests will not pass (i.e. they will not (it "super-groups parameter"
;; signal an error) until the version of org-super-agenda in (let ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]")
;; the test sandbox is upgraded, which I'll do when MELPA (unquoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28message%20%22AHA%22%29%29]]")
;; packages the latest version. On the bright side, I just (quoted-expression-link "[[org-ql-search:todo:?super-groups%3D%28message%20%22AHA%22%29]]")
;; confirmed that, without the fix to org-super-agenda, (unquoted-expression-link "[[org-ql-search:todo:?super-groups%3D%22AHA%22]]")
;; these are vulnerable, which means that the test catches (pred-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Apred%20%28lambda%20%28_%29%20%28message%20%22AHA%22%29%29%29%29]]")
;; this problem and detects the fix. (auto-map-selector-link "[[org-ql-search:todo:?super-groups%3D%28%28%3Aauto-map%20%28lambda%20%28_%29%20%28message%20%22AHA%22%29%29%29%29]]"))
(expect (open-link pred-selector-link) (expect (open-link quoted-lambda-link)
:to-throw 'error '("Unsafe groups disallowed (:pred): (lambda (_) (message AHA))")) :to-throw 'wrong-type-argument '(listp lambda))
(expect (open-link auto-map-selector-link) (expect (open-link unquoted-lambda-link)
:to-throw 'error '("Unsafe groups disallowed (:auto-map): ((lambda (_) (message AHA)))")))) :to-throw 'wrong-type-argument '(listp lambda))
(expect (open-link quoted-expression-link)
:to-throw 'wrong-type-argument '(listp message))
(expect (open-link unquoted-expression-link)
:to-throw 'error '("cl-etypecase failed: AHA, (symbol list)"))
(it "title parameter" ;; FIXME: These two tests will not pass (i.e. they will not
(let ((quoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") ;; signal an error) until the version of org-super-agenda in
(unquoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") ;; the test sandbox is upgraded, which I'll do when MELPA
(expression-link "[[org-ql-search:todo:?title%3D%28message%20%22AHA%22%29]]")) ;; packages the latest version. On the bright side, I just
(expect (open-link quoted-lambda-link) ;; confirmed that, without the fix to org-super-agenda,
:to-throw 'wrong-type-argument '(characterp lambda)) ;; these are vulnerable, which means that the test catches
(expect (open-link unquoted-lambda-link) ;; this problem and detects the fix.
:to-throw 'wrong-type-argument '(characterp lambda)) (expect (open-link pred-selector-link)
(expect (open-link expression-link) :to-throw 'error '("Unsafe groups disallowed (:pred): (lambda (_) (message AHA))"))
:to-throw 'wrong-type-argument '(characterp message)))) (expect (open-link auto-map-selector-link)
:to-throw 'error '("Unsafe groups disallowed (:auto-map): ((lambda (_) (message AHA)))"))))
(it "sort parameter" (it "title parameter"
(let ((quoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") (let ((quoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]")
(unquoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]") (unquoted-lambda-link "[[org-ql-search:todo:?title%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]")
(quoted-lambda-in-list-link "[[org-ql-search:todo:?sort%3D%28%28quote%20%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29%29%29]]") (expression-link "[[org-ql-search:todo:?title%3D%28message%20%22AHA%22%29]]"))
(unquoted-lambda-in-list-link "[[org-ql-search:todo:?sort=((lambda%20nil%20(message%20\"AHA\")))]]")) (expect (open-link quoted-lambda-link)
(expect (open-link quoted-lambda-link) :to-throw 'wrong-type-argument '(characterp lambda))
:to-throw 'error '("Potentially unsafe value found in links SORT parameter ((lambda (_ _) (message AHA))). Link not opened")) (expect (open-link unquoted-lambda-link)
(expect (open-link unquoted-lambda-link) :to-throw 'wrong-type-argument '(characterp lambda))
:to-throw 'error '("Potentially unsafe value found in links SORT parameter ((lambda (_ _) (message AHA))). Link not opened")) (expect (open-link expression-link)
(expect (open-link quoted-lambda-in-list-link) :to-throw 'wrong-type-argument '(characterp message))))
:to-throw 'error '("Potentially unsafe value found in links SORT parameter (((quote (lambda (_ _) (message AHA))))). Link not opened"))
(expect (open-link unquoted-lambda-in-list-link) (it "sort parameter"
:to-throw 'error '("Potentially unsafe value found in links SORT parameter (((lambda nil (message AHA)))). Link not opened"))))))) (let ((quoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]")
(unquoted-lambda-link "[[org-ql-search:todo:?sort%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]")
(quoted-lambda-in-list-link "[[org-ql-search:todo:?sort%3D%28%28quote%20%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29%29%29]]")
(unquoted-lambda-in-list-link "[[org-ql-search:todo:?sort=((lambda%20nil%20(message%20\"AHA\")))]]"))
(expect (open-link quoted-lambda-link)
:to-throw 'error '("Potentially unsafe value found in links SORT parameter ((lambda (_ _) (message AHA))). Link not opened"))
(expect (open-link unquoted-lambda-link)
:to-throw 'error '("Potentially unsafe value found in links SORT parameter ((lambda (_ _) (message AHA))). Link not opened"))
(expect (open-link quoted-lambda-in-list-link)
:to-throw 'error '("Potentially unsafe value found in links SORT parameter (((quote (lambda (_ _) (message AHA))))). Link not opened"))
(expect (open-link unquoted-lambda-in-list-link)
:to-throw 'error '("Potentially unsafe value found in links SORT parameter (((lambda nil (message AHA)))). Link not opened"))))))))
;; Local Variables: ;; Local Variables:
;; truncate-lines: t ;; truncate-lines: t