jiri/org-ql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tests: Add tests for link safety

Browse source
This commit is contained in:
Adam Porter 2020-11-12 00:22:45 -06:00
parent a5d4886880
commit 5e790c48ac
1 changed files with 90 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

91
tests/test-org-ql.el
View file

@ -1127,7 +1127,96 @@ RESULTS should be a list of strings as returned by
(org-ql-it "Tags and to-do"
(org-ql-expect ((and (todo "SOMEDAY")
(tags "Emacs")))
'("Rewrite Emacs in Common Lisp"))))))
'("Rewrite Emacs in Common Lisp")))))
(describe "Org link safety"
;; NOTE: These tests probably do not guarantee safety. Still, these tests are probably
;; better than nothing. In fact, this is pretty cool: by testing for the specific error
;; signal and the arguments to the error, I caught a mistake I made while writing these tests
;; (leaving a closing bracket off one of the links), which caused that test to fail but for a
;; different reason. Were it not for testing the specific error AND its arguments, that test
;; case would have apparently passed, but it would have hidden the mistake in the test.
;; Also, while writing these tests, the version of org-super-agenda in the test sandbox does
;; not have the fix applied yet, and the test for that apparently, correctly does not pass yet.
(require 'org-ql-search)
(require 'org-ql-view)
(cl-flet ((open-link
(link) (with-temp-buffer
(org-mode)
(insert link)
(backward-char 1)
(call-interactively #'org-open-at-point))))
(it "buffers-files parameter"
(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:?buffers-files%3D%28lambda%20nil%20%28message%20%22AHA%22%29%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-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28lambda%20nil%20%28message%20%22AHA%22%29%29%29]]"))
(expect (open-link quoted-lambda-link)
:to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA"))))
(expect (open-link unquoted-lambda-link)
:to-throw 'wrong-type-argument '(stringp (lambda nil (message "AHA"))))
(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"
(let ((quoted-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:?super-groups%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]]")
(unquoted-expression-link "[[org-ql-search:todo:?super-groups%3D%22AHA%22]]")
(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]]")
(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 quoted-lambda-link)
:to-throw 'wrong-type-argument '(listp lambda))
(expect (open-link unquoted-lambda-link)
: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)"))
;; FIXME: These two tests will not pass (i.e. they will not
;; signal an error) until the version of org-super-agenda in
;; the test sandbox is upgraded, which I'll do when MELPA
;; packages the latest version. On the bright side, I just
;; confirmed that, without the fix to org-super-agenda,
;; these are vulnerable, which means that the test catches
;; this problem and detects the fix.
(expect (open-link pred-selector-link)
:to-throw 'error '("Unsafe groups disallowed (:pred): (lambda (_) (message AHA))"))
(expect (open-link auto-map-selector-link)
:to-throw 'error '("Unsafe groups disallowed (:auto-map): ((lambda (_) (message AHA)))"))))
(it "title parameter"
(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:?title%3D%28lambda%20%28_%20_%29%20%28message%20%22AHA%22%29%29]]")
(expression-link "[[org-ql-search:todo:?title%3D%28message%20%22AHA%22%29]]"))
(expect (open-link quoted-lambda-link)
:to-throw 'wrong-type-argument '(characterp lambda))
(expect (open-link unquoted-lambda-link)
:to-throw 'wrong-type-argument '(characterp lambda))
(expect (open-link expression-link)
:to-throw 'wrong-type-argument '(characterp message))))
(it "sort parameter"
(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 link’s SORT parameter ((lambda (_ _) (message AHA))). Link not opened"))
(expect (open-link unquoted-lambda-link)
:to-throw 'error '("Potentially unsafe value found in link’s SORT parameter ((lambda (_ _) (message AHA))). Link not opened"))
(expect (open-link quoted-lambda-in-list-link)
:to-throw 'error '("Potentially unsafe value found in link’s 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 link’s SORT parameter (((lambda nil (message AHA)))). Link not opened")))))))
;; Local Variables:
;; truncate-lines: t