Tests: Use test buffer for link safety tests
This commit is contained in:
Adam Porter
parent
56647d4b11
commit
b90e6e25d0
1 changed files with 76 additions and 68 deletions
|
|
@ -1172,79 +1172,87 @@ RESULTS should be a list of strings as returned by
|
|||
(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))))
|
||||
;; The :auto-map test requires there to be results (because the org-super-agenda :auto-map group's
|
||||
;; key-form, where the safety check is, only gets evaluated when there are results). Using
|
||||
;; `with-temp-buffer' in the `open-link' function causes the temp buffer to be killed before the results
|
||||
;; have a chance to be gathered. So we make a test buffer and run the test in that, with a test heading.
|
||||
|
||||
(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")))))))
|
||||
(let ((test-buffer (get-buffer-create "*test-org-ql*")))
|
||||
(cl-flet ((open-link
|
||||
(link) (with-current-buffer test-buffer
|
||||
(erase-buffer)
|
||||
(org-mode)
|
||||
(insert "* TODO Test heading \n\n")
|
||||
(insert link)
|
||||
(backward-char 1)
|
||||
(call-interactively #'org-open-at-point))))
|
||||
|
||||
(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)"))
|
||||
(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")))))))
|
||||
|
||||
;; 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 "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)"))
|
||||
|
||||
(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))))
|
||||
;; 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 "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")))))))
|
||||
(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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue