Skip to content

Commit c47485b

Browse files
lreadlread
authored
Fix barf-forward for position tracking zipper (#249)
`rewrite-clj.paredit/barf-forward` on zipper created with `:track-position? true` now correctly barfs when current node has children. Bug was in internal `rewrite-clj.custom-zipper.utils/remove-and-move-up` whose only user is `barf-forward`. When adding/verifying tests, converted from `test/are` to `doseq`. Fleshed out existing paredit API tests to also test against `:track-position true?` zipper. Fixes #245
1 parent c69a318 commit c47485b

File tree

4 files changed

+488
-378
lines changed

4 files changed

+488
-378
lines changed

‎CHANGELOG.adoc

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@ A release with known breaking changes is marked with:
2020
=== Unreleased
2121

2222
* bump `org.clojure/tools.reader` to version `1.3.7`
23+
* `rewrite-clj.paredit/barf-forward` on zipper created with `:track-position? true` now correctly barfs when current node has children
24+
https://github.com/clj-commons/rewrite-clj/issues/245[#245]
2325

2426
=== v1.1.47 - 2023-03-25 [[v1.1.47]]
2527

‎src/rewrite_clj/custom_zipper/utils.cljc

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -108,17 +108,24 @@
108108
`[a [|b c d]] -> [a |[c d]]`"
109109
[loc]
110110
(if (zraw/custom-zipper? loc)
111-
(let [{:keys [left]} loc]
112-
(if (seq left)
113-
(-> loc zraw/remove zraw/up)
114-
(zraw/remove loc)))
111+
(let [{:keys [left parent right]} loc]
112+
(if (nil? (:parent parent))
113+
(throw (ex-info "cannot remove at top" {}))
114+
(if (seq left)
115+
;; same as zraw/up, except we don't include our current node
116+
(assoc parent
117+
:changed? true
118+
:node (zraw/make-node loc
119+
(:node parent)
120+
(concat (map first left) right)))
121+
(zraw/remove loc))))
115122
(let [[_node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc]
116123
(if (nil? ppath)
117124
(throw (ex-info "cannot remove at top" {}))
118125
(if (pos? (count l))
119126
(zraw/up (with-meta [(peek l)
120-
(assoc path :l (pop l) :changed? true)]
121-
(meta loc)))
127+
(assoc path :l (pop l) :changed? true)]
128+
(meta loc)))
122129
(with-meta [(zraw/make-node loc (peek pnodes) rs)
123130
(and ppath (assoc ppath :changed? true))]
124131
(meta loc)))))))

‎test/rewrite_clj/custom_zipper/utils_test.cljc

Lines changed: 82 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -1,86 +1,104 @@
11
(ns rewrite-clj.custom-zipper.utils-test
2-
(:require [clojure.test :refer [deftest testing is are]]
3-
[rewrite-clj.custom-zipper.core :as z]
2+
(:require [clojure.test :refer [deftest testing is]]
3+
[rewrite-clj.custom-zipper.core :as zraw]
44
[rewrite-clj.custom-zipper.utils :as u]
55
[rewrite-clj.node :as node]
66
[rewrite-clj.zip.base :as base])
77
#?(:clj (:import clojure.lang.ExceptionInfo)))
88

99
(deftest t-remove-sibling
10-
(let [a (node/token-node 'a)
11-
b (node/token-node 'b)
12-
c (node/token-node 'c)
13-
d (node/token-node 'd)
14-
loc (z/down (base/of-node* (node/forms-node [a b c d])))]
15-
(testing "remove-right"
16-
(let [loc' (u/remove-right loc)]
17-
(is (= 'a (base/sexpr loc')))
18-
(is (= "acd" (base/root-string loc')))))
19-
(testing "remove-left"
20-
(let [loc' (-> loc z/right z/right u/remove-left)]
21-
(is (= 'c (base/sexpr loc')))
22-
(is (= "acd" (base/root-string loc')))))
23-
(testing "remove-and-move-right"
24-
(let [loc' (u/remove-and-move-right (z/right loc))]
25-
(is (= 'c (base/sexpr loc')))
26-
(is (= "acd" (base/root-string loc')))))
27-
(testing "remove-and-move-left"
28-
(let [loc' (-> loc z/right u/remove-and-move-left)]
29-
(is (= 'a (base/sexpr loc')))
30-
(is (= "acd" (base/root-string loc')))))))
10+
(doseq [opts [{} {:track-position? true}]]
11+
(let [a (node/token-node 'a)
12+
b (node/token-node 'b)
13+
c (node/token-node 'c)
14+
d (node/token-node 'd)
15+
loc (zraw/down (base/of-node* (node/forms-node [a b c d]) opts))]
16+
(testing "remove-right"
17+
(let [loc' (u/remove-right loc)]
18+
(is (= 'a (base/sexpr loc')))
19+
(is (= "acd" (base/root-string loc')))))
20+
(testing "remove-left"
21+
(let [loc' (-> loc zraw/right zraw/right u/remove-left)]
22+
(is (= 'c (base/sexpr loc')))
23+
(is (= "acd" (base/root-string loc')))))
24+
(testing "remove-and-move-right"
25+
(let [loc' (u/remove-and-move-right (zraw/right loc))]
26+
(is (= 'c (base/sexpr loc')))
27+
(is (= "acd" (base/root-string loc')))))
28+
(testing "remove-and-move-left"
29+
(let [loc' (-> loc zraw/right u/remove-and-move-left)]
30+
(is (= 'a (base/sexpr loc')))
31+
(is (= "acd" (base/root-string loc'))))))))
3132

3233
(deftest t-remove-and-move-up
33-
(let [root (base/of-string "[a [b c d]]")]
34-
(are [?n ?sexpr ?root-string]
35-
(let [zloc (nth (iterate z/next root) ?n)
36-
zloc' (u/remove-and-move-up zloc)]
37-
(is (= ?sexpr (base/sexpr zloc')))
38-
(is (= ?root-string (base/root-string zloc'))))
39-
4 '[c d] "[a [ c d]]"
40-
6 '[b d] "[a [b d]]")))
34+
(doseq [opts [{} {:track-position? true}]
35+
[s next-count expected-sexpr expected-root-string]
36+
[["[a [b c d]]" 4 '[c d] "[a [ c d]]"]
37+
["[a [b c d]]" 6 '[b d] "[a [b d]]"]
38+
["((x) 1)" 1 '(1) "( 1)"]
39+
["((x)1)" 3 '((x)) "((x))"]]]
40+
(testing (str "opts " opts)
41+
(let [root (base/of-string s opts)
42+
zloc (nth (iterate zraw/next root) next-count)
43+
zloc' (u/remove-and-move-up zloc) ]
44+
(is (= expected-sexpr (base/sexpr zloc')))
45+
(is (= expected-root-string (base/root-string zloc')))))))
4146

4247
(deftest t-remove-and-move-up-throws
43-
;; I can't tell you why, but shadow-cljs will sometimes, under certain vesions of node and
48+
;; I can't tell you why, but shadow-cljs will sometimes, under certain versions of node and
4449
;; other variables I do not understand culminate in a:
4550
;; #object[RangeError RangeError: Maximum call stack size exceeded]
4651
;; when I change this test to use (thrown-with-msg? ...)
47-
(let [zloc (base/of-string "[a [b c d]]")]
48-
(is (= "cannot remove at top" (try
49-
(u/remove-and-move-up zloc)
50-
(catch ExceptionInfo e
51-
;; ex-message is only avail in 1.10 and we support clj >= 1.8
52-
#?(:clj (.getMessage e) :cljs (.-message e))))))))
52+
(doseq [opts [{} {:track-position? true}]]
53+
(let [zloc (base/of-string "[a [b c d]]" opts)]
54+
(is (= "cannot remove at top" (try
55+
(u/remove-and-move-up zloc)
56+
(catch ExceptionInfo e
57+
;; ex-message is only avail in 1.10 and we support clj >= 1.8
58+
#?(:clj (.getMessage e) :cljs (.-message e)))))
59+
opts))))
5360

5461
(deftest t-remove-and-move-left-tracks-current-position-correctly
55-
(are [?n ?pos]
56-
(let [root (base/of-string "[a bb ccc]" {:track-position? true})
57-
zloc (nth (iterate z/next root) ?n)]
58-
(is (= ?pos (z/position (u/remove-and-move-left zloc)))))
59-
3 [1 3]
60-
5 [1 6]
61-
2 [1 2]))
62+
(doseq [[next-count expected-pos expected-root-string]
63+
[[3 [1 3] "[a ccc]"]
64+
[5 [1 6] "[a bb ]"]
65+
[2 [1 2] "[abb ccc]"]]]
66+
(let [root (base/of-string "[a bb ccc]" {:track-position? true})
67+
zloc (nth (iterate zraw/next root) next-count)
68+
zloc (u/remove-and-move-left zloc)]
69+
(is (= expected-pos (zraw/position zloc)))
70+
(is (= expected-root-string (base/root-string zloc))))))
6271

6372
(deftest t-remove-and-move-right-does-not-affect-position
64-
(are [?n ?pos]
65-
(let [root (base/of-string "[a bb ccc]" {:track-position? true})
66-
zloc (nth (iterate z/next root) ?n)]
67-
(is (= ?pos (z/position (u/remove-and-move-right zloc)))))
68-
3 [1 4]
69-
1 [1 2]
70-
2 [1 3]))
73+
(doseq [[next-count expected-pos expected-root-string]
74+
[[3 [1 4] "[a ccc]"]
75+
[1 [1 2] "[ bb ccc]"]
76+
[2 [1 3] "[abb ccc]"]]]
77+
(let [root (base/of-string "[a bb ccc]" {:track-position? true})
78+
zloc (nth (iterate zraw/next root) next-count)
79+
zloc (u/remove-and-move-right zloc)]
80+
(is (= expected-pos (zraw/position zloc)))
81+
(is (= expected-root-string (base/root-string zloc))))))
7182

7283
(deftest t-remove-left-tracks-current-position-correctly
73-
(are [?n ?pos]
74-
(let [root (base/of-string "[a bb ccc]" {:track-position? true})
75-
zloc (nth (iterate z/next root) ?n)]
76-
(is (= ?pos (z/position (u/remove-left zloc)))))
77-
3 [1 3]
78-
5 [1 6]))
84+
(doseq [[next-count expected-pos expected-root-string]
85+
[[3 [1 3] "[abb ccc]"]
86+
[5 [1 6] "[a bbccc]"]]]
87+
(let [root (base/of-string "[a bb ccc]" {:track-position? true})
88+
zloc (nth (iterate zraw/next root) next-count)
89+
zloc (u/remove-left zloc)]
90+
(is (= expected-pos (zraw/position zloc)))
91+
(is (= expected-root-string (base/root-string zloc))))))
7992

8093
(deftest t-remove-and-move-up-tracks-current-position-correctly
81-
(are [?n ?pos]
82-
(let [root (base/of-string "[a1 [bb4 ccc6]]" {:track-position? true})
83-
zloc (nth (iterate z/next root) ?n)]
84-
(is (= ?pos (z/position (u/remove-and-move-up zloc)))))
85-
4 [1 5]
86-
6 [1 5]))
94+
(doseq [[s next-count expected-pos expected-string expected-root-string]
95+
[["[a1 [bb4 ccc6]]" 4 [1 5] "[ ccc6]" "[a1 [ ccc6]]"]
96+
["[a1 [bb4 ccc6]]" 6 [1 5] "[bb4 ]" "[a1 [bb4 ]]"]
97+
["((x) 1)" 1 [1 1] "( 1)" "( 1)"]
98+
["((x)1)" 3 [1 1] "((x))" "((x))"]]]
99+
(let [root (base/of-string s {:track-position? true})
100+
zloc (nth (iterate zraw/next root) next-count)
101+
zloc (u/remove-and-move-up zloc)]
102+
(is (= expected-pos (zraw/position zloc)))
103+
(is (= expected-string (base/string zloc)))
104+
(is (= expected-root-string (base/root-string zloc))))))

0 commit comments

Comments
 (0)