Tests: Use test buffer for link safety tests
This commit is contained in:
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-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 link’s 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 link’s 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 link’s 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 link’s 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 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:
|
;; Local Variables:
|
||||||
;; truncate-lines: t
|
;; truncate-lines: t
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue