Fix: (heading) Don't match strings as regexps

Reported-by: Alex Popescu <https://github.com/al3xandru>
This commit is contained in:
Adam Porter 2024-02-21 04:57:44 -06:00
parent 770e60766a
commit b6efba9aeb
4 changed files with 61 additions and 73 deletions

View file

@ -555,7 +555,8 @@ Simple links may also be written manually in either sexp or non-sexp form, like:
** 0.8.5-pre
Nothing new yet.
*Fixes*
+ Predicate ~heading~ incorrectly matched strings as regular expressions, sometimes returning incorrect results. (See [[https://github.com/alphapapa/org-ql/discussions/410][discussion]]. Thanks to [[https://github.com/al3xandru][Alex Popescu]] for reporting.)
** 0.8.4

View file

@ -1461,40 +1461,16 @@ Org effort string, like \"5\" or \"0:05\"."
(list :regexp (rx bol (0+ space) ":STYLE:" (1+ space) "habit" (0+ space) eol))))
:body (org-is-habit-p))
(org-ql-defpred (heading h) (&rest strings)
(org-ql-defpred (heading h) (&rest _strings)
"Return non-nil if current entry's heading matches all STRINGS.
Matching is done case-insensitively."
:coalesce t
:normalizers ((`(,predicate-names . ,args)
;; "h" alias.
`(heading ,@args)))
;; TODO: Adjust regexp to avoid matching in tag list.
:preambles ((`(,predicate-names)
;; This clause protects against the case in which the
;; arguments are nil, which would cause an error in
;; `rx-to-string' in other clauses. This can happen
;; with `org-ql-completing-read', e.g. when the input
;; is "h:" while the user is typing.
(list :regexp (rx bol (1+ "*") (1+ blank) (0+ nonl))
:case-fold t :query query))
(`(,predicate-names ,string)
;; Only one string: match with preamble, then let predicate confirm (because
;; the match could be in e.g. the tags rather than the heading text).
(list :regexp (rx-to-string `(seq bol (1+ "*") (1+ blank) (0+ nonl)
,string)
'no-group)
:case-fold t :query query))
(`(,predicate-names . ,strings)
;; Multiple strings: use preamble to match against first
;; string, then let the predicate match the rest.
(list :regexp (rx-to-string `(seq bol (1+ "*") (1+ blank) (0+ nonl)
,(car strings))
'no-group)
:case-fold t :query query)))
;; TODO: In Org 9.2+, `org-get-heading' takes 2 more arguments.
:body (let ((heading (org-get-heading 'no-tags 'no-todo))
(case-fold-search t))
(--all? (string-match it heading) strings)))
;; NOTE: Each string argument must be converted to a regexp
;; for testing by the body, so we just normalize to the
;; `heading-regexp' predicate, leaving this predicate as
;; one that merely regexp-quotes its arguments.
`(heading-regexp ,@(mapcar #'regexp-quote args)))))
(org-ql-defpred (heading-regexp h*) (&rest regexps)
"Return non-nil if current entry's heading matches all REGEXPS (regexp strings).

View file

@ -1076,7 +1076,12 @@ File: README.info, Node: 085-pre, Next: 084, Up: Changelog
5.1 0.8.5-pre
=============
Nothing new yet.
*Fixes*
• Predicate heading incorrectly matched strings as regular
expressions, sometimes returning incorrect results. (See
discussion (https://github.com/alphapapa/org-ql/discussions/410).
Thanks to Alex Popescu (https://github.com/al3xandru) for
reporting.)

File: README.info, Node: 084, Next: 083, Prev: 085-pre, Up: Changelog
@ -1979,45 +1984,45 @@ Node: Links38883
Node: Tips39570
Node: Changelog39894
Node: 085-pre40788
Node: 08440900
Node: 08341356
Node: 08241697
Node: 08142090
Node: 0842511
Node: 07445235
Node: 07345458
Node: 07246190
Node: 07147109
Node: 0747920
Node: 06350786
Node: 06251319
Node: 06151626
Node: 0652196
Node: 05255252
Node: 05155554
Node: 0555979
Node: 04957510
Node: 04857792
Node: 04758141
Node: 04658550
Node: 04558958
Node: 04459319
Node: 04359678
Node: 04259881
Node: 04160042
Node: 0460289
Node: 03264390
Node: 03164793
Node: 0364990
Node: 02368290
Node: 02268524
Node: 02168804
Node: 0269009
Node: 0173087
Node: Notes73188
Node: Comparison with Org Agenda searches73350
Node: org-sidebar74239
Node: License74518
Node: 08441175
Node: 08341631
Node: 08241972
Node: 08142365
Node: 0842786
Node: 07445510
Node: 07345733
Node: 07246465
Node: 07147384
Node: 0748195
Node: 06351061
Node: 06251594
Node: 06151901
Node: 0652471
Node: 05255527
Node: 05155829
Node: 0556254
Node: 04957785
Node: 04858067
Node: 04758416
Node: 04658825
Node: 04559233
Node: 04459594
Node: 04359953
Node: 04260156
Node: 04160317
Node: 0460564
Node: 03264665
Node: 03165068
Node: 0365265
Node: 02368565
Node: 02268799
Node: 02169079
Node: 0269284
Node: 0173362
Node: Notes73463
Node: Comparison with Org Agenda searches73625
Node: org-sidebar74514
Node: License74793

End Tag Table

View file

@ -218,7 +218,8 @@ with keyword arg NOW in PLIST."
(it "coalesces a single AND clause that uses two predicates (and preserves predicate order)"
(expect (org-ql--normalize-query '(and (rifle "foo") (rifle "bar")
(heading "baz") (heading "buz")))
:to-equal '(and (rifle :regexps '("foo" "bar")) (heading "baz" "buz"))))
;; NOTE: `heading' is normalized to `heading-regexp'.
:to-equal '(and (rifle :regexps '("foo" "bar")) (heading-regexp "baz" "buz"))))
(it "preserves independent OR clauses"
(expect (org-ql--normalize-query '(and (or (rifle "foo") (rifle "bar"))
(or (rifle "baz") (rifle "buz"))))
@ -1112,7 +1113,12 @@ with keyword arg NOW in PLIST."
'("Take over the world")))
(org-ql-it "with two arguments"
(org-ql-expect ('(heading "Take over" "world"))
'("Take over the world"))))
'("Take over the world")))
(org-ql-it "does not match strings as regexps"
(org-ql-expect ('(heading "over"))
'("Take over the universe" "Take over the world" "Take over Mars" "Take over the moon"))
(org-ql-expect ('(heading "[over]"))
nil)))
(describe "(heading-regexp)"
(org-ql-it "with one argument"