diff --git a/Eldev b/Eldev index e6b3c00..7a30881 100644 --- a/Eldev +++ b/Eldev @@ -25,3 +25,12 @@ enable-local-variables :safe)) (setq eldev-project-main-file "clojure-ts-mode.el") + +;; Exclude tests merged from clojure-mode from running, linting and byte compiling +(setf eldev-test-fileset + `(:and ,eldev-test-fileset + (:not "./clojure-mode-tests/*"))) +(setf eldev-standard-excludes + `(:or ,eldev-standard-excludes "./clojure-mode-tests/*")) +(setf eldev-lint-ignored-fileset + `(:or ,eldev-lint-ignored-fileset "./clojure-mode-tests/*")) diff --git a/clojure-mode-tests/clojure-mode-convert-collection-test.el b/clojure-mode-tests/clojure-mode-convert-collection-test.el new file mode 100644 index 0000000..14e5291 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-convert-collection-test.el @@ -0,0 +1,82 @@ +;;; clojure-mode-convert-collection-test.el --- Clojure Mode: convert collection type -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The convert collection code originally was implemented +;; as cycling collection type in clj-refactor.el and is the work +;; of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-convert-collection-to-map" + (when-refactoring-it "should convert a list to a map" + "(:a 1 :b 2)" + "{:a 1 :b 2}" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-map))) + +(describe "clojure-convert-collection-to-vector" + (when-refactoring-it "should convert a map to a vector" + "{:a 1 :b 2}" + "[:a 1 :b 2]" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-vector))) + +(describe "clojure-convert-collection-to-set" + (when-refactoring-it "should convert a vector to a set" + "[1 2 3]" + "#{1 2 3}" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-set))) + +(describe "clojure-convert-collection-to-list" + (when-refactoring-it "should convert a set to a list" + "#{1 2 3}" + "(1 2 3)" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-list))) + +(describe "clojure-convert-collection-to-quoted-list" + (when-refactoring-it "should convert a set to a quoted list" + "#{1 2 3}" + "'(1 2 3)" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-quoted-list))) + +(describe "clojure-convert-collection-to-set" + (when-refactoring-it "should convert a quoted list to a set" + "'(1 2 3)" + "#{1 2 3}" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-set))) + +(provide 'clojure-mode-convert-collection-test) + +;;; clojure-mode-convert-collection-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-cycling-test.el b/clojure-mode-tests/clojure-mode-cycling-test.el new file mode 100644 index 0000000..e1dcc46 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-cycling-test.el @@ -0,0 +1,194 @@ +;;; clojure-mode-cycling-test.el --- Clojure Mode: cycling things tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The cycling privacy and if/if-not code is ported from +;; clj-refactor.el and the work of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure-cycle-privacy" + + (when-refactoring-it "should turn a public defn into a private defn" + "(defn add [a b] + (+ a b))" + + "(defn- add [a b] + (+ a b))" + + (clojure-cycle-privacy)) + + (when-refactoring-it "should also work from the beginning of a sexp" + "(defn- add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (backward-sexp) + (clojure-cycle-privacy)) + + (when-refactoring-it "should use metadata when clojure-use-metadata-for-privacy is set to true" + "(defn add [a b] + (+ a b))" + + "(defn ^:private add [a b] + (+ a b))" + + (let ((clojure-use-metadata-for-privacy t)) + (clojure-cycle-privacy))) + + (when-refactoring-it "should turn a private defn into a public defn" + "(defn- add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (clojure-cycle-privacy)) + + (when-refactoring-it "should turn a private defn with metadata into a public defn" + "(defn ^:private add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (let ((clojure-use-metadata-for-privacy t)) + (clojure-cycle-privacy))) + + (when-refactoring-it "should also work with pre-existing metadata" + "(def ^:dynamic config + \"docs\" + {:env \"staging\"})" + + "(def ^:private ^:dynamic config + \"docs\" + {:env \"staging\"})" + + (clojure-cycle-privacy)) + + (when-refactoring-it "should turn a private def with metadata into a public def" + "(def ^:private config + \"docs\" + {:env \"staging\"})" + + "(def config + \"docs\" + {:env \"staging\"})" + + (clojure-cycle-privacy))) + +(describe "clojure-cycle-if" + + (when-refactoring-it "should cycle inner if" + "(if this + (if that + (then AAA) + (else BBB)) + (otherwise CCC))" + + "(if this + (if-not that + (else BBB) + (then AAA)) + (otherwise CCC))" + + (beginning-of-buffer) + (search-forward "BBB)") + (clojure-cycle-if)) + + (when-refactoring-it "should cycle outer if" + "(if-not this + (if that + (then AAA) + (else BBB)) + (otherwise CCC))" + + "(if this + (otherwise CCC) + (if that + (then AAA) + (else BBB)))" + + (beginning-of-buffer) + (search-forward "BBB))") + (clojure-cycle-if))) + +(describe "clojure-cycle-when" + + (when-refactoring-it "should cycle inner when" + "(when this + (when that + (aaa) + (bbb)) + (ccc))" + + "(when this + (when-not that + (aaa) + (bbb)) + (ccc))" + + (beginning-of-buffer) + (search-forward "bbb)") + (clojure-cycle-when)) + + (when-refactoring-it "should cycle outer when" + "(when-not this + (when that + (aaa) + (bbb)) + (ccc))" + + "(when this + (when that + (aaa) + (bbb)) + (ccc))" + + (beginning-of-buffer) + (search-forward "bbb))") + (clojure-cycle-when))) + +(describe "clojure-cycle-not" + + (when-refactoring-it "should add a not when missing" + "(ala bala portokala)" + "(not (ala bala portokala))" + + (beginning-of-buffer) + (search-forward "bala") + (clojure-cycle-not)) + + (when-refactoring-it "should remove a not when present" + "(not (ala bala portokala))" + "(ala bala portokala)" + + (beginning-of-buffer) + (search-forward "bala") + (clojure-cycle-not))) + +(provide 'clojure-mode-cycling-test) + +;;; clojure-mode-cycling-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-external-interaction-test.el b/clojure-mode-tests/clojure-mode-external-interaction-test.el new file mode 100644 index 0000000..e394f9d --- /dev/null +++ b/clojure-mode-tests/clojure-mode-external-interaction-test.el @@ -0,0 +1,135 @@ +;;; clojure-mode-external-interaction-test.el --- Clojure Mode interactions with external packages test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'paredit) +(require 'test-helper "test/utils/test-helper") + +(describe "Interactions with Paredit:" + ;; reuse existing when-refactoring-it macro + (describe "it should insert a space" + (when-refactoring-it "before lists" + "foo" + "foo ()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "before vectors" + "foo" + "foo []" + (paredit-mode) + (paredit-open-square)) + (when-refactoring-it "before maps" + "foo" + "foo {}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "before strings" + "foo" + "foo \"\"" + (paredit-mode) + (paredit-doublequote)) + (when-refactoring-it "after gensym" + "foo#" + "foo# ()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "after symbols ending with '" + "foo'" + "foo' ()" + (paredit-mode) + (paredit-open-round))) + (describe "it should not insert a space" + (when-refactoring-it "for anonymous fn syntax" + "foo #" + "foo #()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "for hash sets" + "foo #" + "foo #{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "for regexes" + "foo #" + "foo #\"\"" + (paredit-mode) + (paredit-doublequote)) + (when-refactoring-it "for quoted collections" + "foo '" + "foo '()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "for reader conditionals" + "foo #?" + "foo #?()" + (paredit-mode) + (paredit-open-round))) + (describe "reader tags" + (when-refactoring-it "should insert a space before strings" + "#uuid" + "#uuid \"\"" + (paredit-mode) + (paredit-doublequote)) + (when-refactoring-it "should not insert a space before namespaced maps" + "#::my-ns" + "#::my-ns{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "should not insert a space before namespaced maps 2" + "#::" + "#::{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "should not insert a space before namespaced maps 3" + "#:fully.qualified.ns123.-$#.%*+!" + "#:fully.qualified.ns123.-$#.%*+!{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "should not insert a space before tagged vectors" + "#tag123.-$#.%*+!" + "#tag123.-$#.%*+![]" + (paredit-mode) + (paredit-open-square)))) + + +(describe "Interactions with delete-trailing-whitespace" + (when-refactoring-it "should not delete trailing commas" + "(def foo + \\\"foo\\\": 1, + \\\"bar\\\": 2} + +(-> m + (assoc ,,, + :foo 123))" + "(def foo + \\\"foo\\\": 1, + \\\"bar\\\": 2} + +(-> m + (assoc ,,, + :foo 123))" + (delete-trailing-whitespace))) + +(provide 'clojure-mode-external-interaction-test) + + +;;; clojure-mode-external-interaction-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-font-lock-test.el b/clojure-mode-tests/clojure-mode-font-lock-test.el new file mode 100644 index 0000000..3477190 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-font-lock-test.el @@ -0,0 +1,1048 @@ +;;; clojure-mode-font-lock-test.el --- Clojure Mode: Font lock test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: + +(require 'clojure-mode) +(require 'cl-lib) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + + +;;;; Utilities + +(defmacro with-fontified-clojure-buffer (content &rest body) + "Evaluate BODY in a temporary buffer with CONTENT." + (declare (debug t) + (indent 1)) + `(with-clojure-buffer ,content + (font-lock-ensure) + (goto-char (point-min)) + ,@body)) + +(defun clojure-get-face-at (start end content) + "Get the face between START and END in CONTENT." + (with-fontified-clojure-buffer content + (let ((start-face (get-text-property start 'face)) + (all-faces (cl-loop for i from start to end collect (get-text-property + i 'face)))) + (if (cl-every (lambda (face) (eq face start-face)) all-faces) + start-face + 'various-faces)))) + +(defun expect-face-at (content start end face) + "Expect face in CONTENT between START and END to be equal to FACE." + (expect (clojure-get-face-at start end content) :to-equal face)) + +(defun expect-faces-at (content &rest faces) + "Expect FACES in CONTENT. + +FACES is a list of the form (content (start end expected-face)*)" + (dolist (face faces) + (apply (apply-partially #'expect-face-at content) face))) + +(defconst clojure-test-syntax-classes + [whitespace punctuation word symbol open-paren close-paren expression-prefix + string-quote paired-delim escape character-quote comment-start + comment-end inherit generic-comment generic-string] + "Readable symbols for syntax classes. + +Each symbol in this vector corresponding to the syntax code of +its index.") + +(defmacro when-fontifying-it (description &rest tests) + "Return a buttercup spec. + +TESTS are lists of the form (content (start end expected-face)*). For each test +check that each `expected-face` is found in `content` between `start` and `end`. + +DESCRIPTION is the description of the spec." + (declare (indent 1)) + `(it ,description + (dolist (test (quote ,tests)) + (apply #'expect-faces-at test)))) + +;;;; Font locking + +(describe "clojure-mode-syntax-table" + + (when-fontifying-it "should handle stuff in backticks" + ("\"`#'s/trim`\"" + (1 2 font-lock-string-face) + (3 10 (font-lock-constant-face font-lock-string-face)) + (11 12 font-lock-string-face)) + + (";`#'s/trim`" + (1 1 font-lock-comment-delimiter-face) + (2 2 font-lock-comment-face) + (3 10 (font-lock-constant-face font-lock-comment-face)) + (11 11 font-lock-comment-face))) + + (when-fontifying-it "should handle stuff in strings" + ("\"a\\bc\\n\"" + (1 2 font-lock-string-face) + (3 4 (bold font-lock-string-face)) + (5 5 font-lock-string-face) + (6 7 (bold font-lock-string-face))) + + ("#\"a\\bc\\n\"" + (4 5 (bold font-lock-string-face)))) + + (when-fontifying-it "should handle stuff in double brackets" + ("\"[[#'s/trim]]\"" + (1 3 font-lock-string-face) + (4 11 (font-lock-constant-face font-lock-string-face)) + (12 14 font-lock-string-face)) + + (";[[#'s/trim]]" + (1 1 font-lock-comment-delimiter-face) + (2 3 font-lock-comment-face) + (4 11 (font-lock-constant-face font-lock-comment-face)) + (12 13 font-lock-comment-face))) + + (when-fontifying-it "should fontify let, when, and while type forms" + ("(when-alist [x 1]\n ())" + (2 11 font-lock-keyword-face)) + + ("(while-alist [x 1]\n ())" + (2 12 font-lock-keyword-face)) + + ("(let-alist [x 1]\n ())" + (2 10 font-lock-keyword-face))) + + (when-fontifying-it "should handle comment macros" + ("#_" + (1 2 nil)) + + ("#_#_" + (1 2 nil)) + + ("#_#_" + (3 2 font-lock-comment-face)) + + ("#_ #_" + (1 3 nil)) + + ("#_ #_" + (4 2 font-lock-comment-face)) + + ("#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)" + (1 2 nil)) + + ("#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)" + (5 41 font-lock-comment-face)) + + ("#_#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (1 4 nil)) + + ("#_ #_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (1 5 nil)) + + ("#_#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (7 75 font-lock-comment-face)) + + ("#_ #_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (8 75 font-lock-comment-face))) + + (when-fontifying-it "should handle namespace declarations" + ("(ns .validns)" + (5 12 font-lock-type-face)) + + ("(ns =validns)" + (5 12 font-lock-type-face)) + + ("(ns .ValidNs=<>?+|?*.)" + (5 21 font-lock-type-face)) + + ("(ns ValidNs<>?+|?*.b*ar.ba*z)" + (5 28 font-lock-type-face)) + + ("(ns other.valid.ns)" + (5 18 font-lock-type-face)) + + ("(ns oneword)" + (5 11 font-lock-type-face)) + + ("(ns foo.bar)" + (5 11 font-lock-type-face)) + + ("(ns Foo.bar)" + (5 11 font-lock-type-face) + (5 11 font-lock-type-face) + (5 11 font-lock-type-face)) + + ("(ns Foo-bar)" + (5 11 font-lock-type-face) + (5 11 font-lock-type-face)) + + ("(ns foo-Bar)" + (5 11 font-lock-type-face)) + + ("(ns one.X)" + (5 9 font-lock-type-face)) + + ("(ns ^:md ns-name)" + (10 16 font-lock-type-face)) + + ("(ns ^:md \n ns-name)" + (13 19 font-lock-type-face)) + + ("(ns ^:md1 ^:md2 ns-name)" + (17 23 font-lock-type-face)) + + ("(ns ^:md1 ^{:md2 true} ns-name)" + (24 30 font-lock-type-face)) + + ("(ns ^{:md2 true} ^:md1 ns-name)" + (24 30 font-lock-type-face)) + + ("(ns ^:md1 ^{:md2 true} \n ns-name)" + (27 33 font-lock-type-face)) + + ("(ns ^{:md2 true} ^:md1 \n ns-name)" + (27 33 font-lock-type-face))) + + (when-fontifying-it "should handle one word" + (" oneword" + (2 8 nil)) + + ("@oneword" + (2 8 nil)) + + ("#oneword" + (2 8 nil)) + + (".oneword" + (2 8 nil)) + + ("#^oneword" + (3 9 font-lock-type-face)) ;; type-hint + + ("(oneword)" + (2 8 nil)) + + ("(oneword/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(oneword/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(oneword/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(oneword/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(colons:are:okay)" + (2 16 nil)) + + ("(some-ns/colons:are:okay)" + (2 8 font-lock-type-face) + (9 24 nil)) + + ("(oneword/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(oneword/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle a segment" + (" seg.mnt" + (2 8 nil)) + + ("@seg.mnt" + (2 8 nil)) + + ("#seg.mnt" + (2 8 nil)) + + (".seg.mnt" + (2 8 nil)) + + ("#^seg.mnt" + (3 9 font-lock-type-face)) ;; type-hint + + ("(seg.mnt)" + (2 8 nil)) + + ("(seg.mnt/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(seg.mnt/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle camelcase" + (" CmlCase" + (2 8 nil)) + + ("@CmlCase" + (2 8 nil)) + + ("#CmlCase" + (2 8 nil)) + + (".CmlCase" + (2 8 nil)) + + ("#^CmlCase" + (3 9 font-lock-type-face)) ;; type-hint + + ("(CmlCase)" + (2 8 nil)) + + ("(CmlCase/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(CmlCase/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle mixed case" + (" mxdCase" + (2 8 nil)) + + ("@mxdCase" + (2 8 nil)) + + ("#mxdCase" + (2 8 nil)) + + (".mxdCase" + (2 8 nil)) + + ("#^mxdCase" + (3 9 font-lock-type-face)) ;; type-hint + + ("(mxdCase)" + (2 8 nil)) + + ("(mxdCase/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(mxdCase/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle quotes in tail of symbols and keywords" + ("'quot'ed'/sy'm'bol''" + (2 9 font-lock-type-face) + (10 20 nil)) + + (":qu'ote'd''/key'word'" + (2 11 font-lock-type-face) + (12 12 default) + (13 21 clojure-keyword-face))) + + (when-fontifying-it "should handle very complex stuff" + (" ve/yCom|pLex.stu-ff" + (3 4 font-lock-type-face) + (5 21 nil)) + + (" @ve/yCom|pLex.stu-ff" + (2 2 nil) + (3 4 font-lock-type-face) + (5 21 nil)) + + (" #ve/yCom|pLex.stu-ff" + (2 4 font-lock-type-face) + (5 21 nil)) + + (" .ve/yCom|pLex.stu-ff" + (2 4 font-lock-type-face) + (5 21 nil)) + + ;; type-hint + ("#^ve/yCom|pLex.stu-ff" + (1 2 default) + (3 4 font-lock-type-face) + (5 21 default)) + + ("^ve/yCom|pLex.stu-ff" + (2 3 font-lock-type-face) + (5 20 default)) + + (" (ve/yCom|pLex.stu-ff)" + (3 4 font-lock-type-face) + (5 21 nil)) + + (" (ve/yCom|pLex.stu-ff/oneword)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/seg.mnt)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/mxdCase)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/CmlCase)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/ve/yCom|pLex.stu-ff)" + (3 4 font-lock-type-face) + (5 41 nil)) + + (" (ve/yCom|pLex.stu-ff/.ve/yCom|pLex.stu-ff)" + (3 4 font-lock-type-face) + (5 42 nil))) + + (when-fontifying-it "should handle oneword keywords" + (" :oneword" + (3 9 clojure-keyword-face)) + + (" :1oneword" + (3 10 clojure-keyword-face)) + + ("{:oneword 0}" + (3 9 clojure-keyword-face)) + + ("{:1oneword 0}" + (3 10 clojure-keyword-face)) + + ("{:#oneword 0}" + (3 10 clojure-keyword-face)) + + ("{:.oneword 0}" + (3 10 clojure-keyword-face)) + + ("{:oneword/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/seg.mnt 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:oneword/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle namespaced keywords" + ("::foo" + (1 5 clojure-keyword-face)) + + (":_::_:foo" + (1 9 clojure-keyword-face)) + + (":_:_:foo" + (1 8 clojure-keyword-face)) + + (":foo/:bar" + (1 9 clojure-keyword-face)) + + ("::_:foo" + (1 7 clojure-keyword-face)) + + ("::_:_:foo" + (1 9 clojure-keyword-face)) + + (":_:_:foo/_" + (1 1 clojure-keyword-face) + (2 8 font-lock-type-face) + (9 9 default) + (10 10 clojure-keyword-face)) + + (":_:_:foo/bar" + (10 12 clojure-keyword-face)) + + (":_:_:foo/bar/eee" + (10 16 clojure-keyword-face)) + + (":_:_:foo/bar_:foo" + (10 17 clojure-keyword-face)) + + (":_:_:foo/bar_:_:foo" + (10 19 clojure-keyword-face)) + + (":1foo/bar" + (2 5 font-lock-type-face) + (6 6 default) + (7 9 clojure-keyword-face)) + + (":foo/1bar" + (2 4 font-lock-type-face) + (5 5 default) + (6 9 clojure-keyword-face)) + + (":1foo/1bar" + (2 5 font-lock-type-face) + (6 6 default) + (7 10 clojure-keyword-face))) + + (when-fontifying-it "should handle segment keywords" + (" :seg.mnt" + (3 9 clojure-keyword-face)) + + ("{:seg.mnt 0}" + (3 9 clojure-keyword-face)) + + ("{:#seg.mnt 0}" + (3 10 clojure-keyword-face)) + + ("{:.seg.mnt 0}" + (3 10 clojure-keyword-face)) + + ("{:seg.mnt/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/seg.mnt 0}" + (3 9 font-lock-type-face ) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:seg.mnt/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle camel case keywords" + (" :CmlCase" + (3 9 clojure-keyword-face)) + + ("{:CmlCase 0}" + (3 9 clojure-keyword-face)) + + ("{:#CmlCase 0}" + (3 10 clojure-keyword-face)) + + ("{:.CmlCase 0}" + (3 10 clojure-keyword-face)) + + ("{:CmlCase/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/seg.mnt 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:CmlCase/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle mixed case keywords" + (" :mxdCase" + (3 9 clojure-keyword-face)) + + ("{:mxdCase 0}" + (3 9 clojure-keyword-face)) + + ("{:#mxdCase 0}" + (3 10 clojure-keyword-face)) + + ("{:.mxdCase 0}" + (3 10 clojure-keyword-face)) + + ("{:mxdCase/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/seg.mnt 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:mxdCase/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle keywords with colons" + (":a:a" + (1 4 clojure-keyword-face)) + + (":a:a/:a" + (1 7 clojure-keyword-face)) + + ("::a:a" + (1 5 clojure-keyword-face)) + + ("::a.a:a" + (1 7 clojure-keyword-face))) + + (when-fontifying-it "should handle very complex keywords" + (" :ve/yCom|pLex.stu-ff" + (3 4 font-lock-type-face) + (5 5 default) + (6 21 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 21 clojure-keyword-face)) + + ("{:#ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 5 font-lock-type-face) + (6 6 default) + (7 22 clojure-keyword-face)) + + ("{:.ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 5 font-lock-type-face) + (6 6 default) + (7 22 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/oneword 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/seg.mnt 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/ClmCase 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/mxdCase 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 41 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/.ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 42 clojure-keyword-face))) + + (when-fontifying-it "should handle namespaced defs" + ("(clojure.core/defn bar [] nil)" + (2 13 font-lock-type-face) + (14 14 nil) + (15 18 font-lock-keyword-face) + (20 22 font-lock-function-name-face)) + + ("(clojure.core/defrecord foo nil)" + (2 13 font-lock-type-face) + (14 14 nil) + (15 23 font-lock-keyword-face) + (25 27 font-lock-type-face)) + + ("(s/def ::keyword)" + (2 2 font-lock-type-face) + (3 3 nil) + (4 6 font-lock-keyword-face) + (8 16 clojure-keyword-face))) + + (when-fontifying-it "should handle any known def form" + ("(def a 1)" (2 4 font-lock-keyword-face)) + ("(defonce a 1)" (2 8 font-lock-keyword-face)) + ("(defn a [b])" (2 5 font-lock-keyword-face)) + ("(defmacro a [b])" (2 9 font-lock-keyword-face)) + ("(definline a [b])" (2 10 font-lock-keyword-face)) + ("(defmulti a identity)" (2 9 font-lock-keyword-face)) + ("(defmethod a :foo [b] (println \"bar\"))" (2 10 font-lock-keyword-face)) + ("(defprotocol a (b [this] \"that\"))" (2 12 font-lock-keyword-face)) + ("(definterface a (b [c]))" (2 13 font-lock-keyword-face)) + ("(defrecord a [b c])" (2 10 font-lock-keyword-face)) + ("(deftype a [b c])" (2 8 font-lock-keyword-face)) + ("(defstruct a :b :c)" (2 10 font-lock-keyword-face)) + ("(deftest a (is (= 1 1)))" (2 8 font-lock-keyword-face)) + ("(defne [x y])" (2 6 font-lock-keyword-face)) + ("(defnm a b)" (2 6 font-lock-keyword-face)) + ("(defnu)" (2 6 font-lock-keyword-face)) + ("(defnc [a])" (2 6 font-lock-keyword-face)) + ("(defna)" (2 6 font-lock-keyword-face)) + ("(deftask a)" (2 8 font-lock-keyword-face)) + ("(defstate a :start \"b\" :stop \"c\")" (2 9 font-lock-keyword-face))) + + (when-fontifying-it "should ignore unknown def forms" + ("(defbugproducer me)" (2 15 nil)) + ("(default-user-settings {:a 1})" (2 24 nil)) + ("(s/deftartar :foo)" (4 10 nil))) + + (when-fontifying-it "should handle variables defined with def" + ("(def foo 10)" + (2 4 font-lock-keyword-face) + (6 8 font-lock-variable-name-face)) + ("(def foo:bar 10)" + (2 4 font-lock-keyword-face) + (6 12 font-lock-variable-name-face))) + + (when-fontifying-it "should handle variables definitions of type string" + ("(def foo \"hello\")" + (10 16 font-lock-string-face)) + + ("(def foo \"hello\" )" + (10 16 font-lock-string-face)) + + ("(def foo \n \"hello\")" + (13 19 font-lock-string-face)) + + ("(def foo \n \"hello\"\n)" + (13 19 font-lock-string-face))) + + (when-fontifying-it "variable-def-string-with-docstring" + ("(def foo \"usage\" \"hello\")" + (10 16 font-lock-doc-face) + (18 24 font-lock-string-face)) + + ("(def foo \"usage\" \"hello\" )" + (18 24 font-lock-string-face)) + + ("(def foo \"usage\" \n \"hello\")" + (21 27 font-lock-string-face)) + + ("(def foo \n \"usage\" \"hello\")" + (13 19 font-lock-doc-face)) + + ("(def foo \n \"usage\" \n \"hello\")" + (13 19 font-lock-doc-face) + (24 30 font-lock-string-face)) + + ("(def test-string\n \"this\\n\n is\n my\n string\")" + (20 24 font-lock-string-face) + (25 26 (bold font-lock-string-face)) + (27 46 font-lock-string-face))) + + (when-fontifying-it "should handle deftype" + ("(deftype Foo)" + (2 8 font-lock-keyword-face) + (10 12 font-lock-type-face))) + + (when-fontifying-it "should handle defn" + ("(defn foo [x] x)" + (2 5 font-lock-keyword-face) + (7 9 font-lock-function-name-face))) + + (when-fontifying-it "should handle fn" + ;; try to byte-recompile the clojure-mode.el when the face of 'fn' is 't' + ("(fn foo [x] x)" + (2 3 font-lock-keyword-face) + ( 5 7 font-lock-function-name-face))) + + (when-fontifying-it "should handle lambda-params %, %1, %n..." + ("#(+ % %2 %3 %&)" + (5 5 font-lock-variable-name-face) + (7 8 font-lock-variable-name-face) + (10 11 font-lock-variable-name-face) + (13 14 font-lock-variable-name-face))) + + (when-fontifying-it "should handle multi-digit lambda-params" + ;; % args with >1 digit are rare and unidiomatic but legal up to + ;; `MAX_POSITIONAL_ARITY` in Clojure's compiler, which as of today is 20 + ("#(* %10 %15 %19 %20)" + ;; it would be better if this were just `font-lock-variable-name-face` but + ;; it seems to work as-is + (5 7 various-faces) + (9 11 font-lock-variable-name-face) + (13 15 font-lock-variable-name-face) + (17 19 various-faces))) + + (when-fontifying-it "should handle nils" + ("(= nil x)" + (4 6 font-lock-constant-face)) + + ("(fnil x)" + (3 5 nil))) + + (when-fontifying-it "should handle true" + ("(= true x)" + (4 7 font-lock-constant-face))) + + (when-fontifying-it "should handle false" + ("(= false x)" + (4 8 font-lock-constant-face))) + + (when-fontifying-it "should handle keyword-meta" + ("^:meta-data" + (1 1 nil) + (2 11 clojure-keyword-face))) + + (when-fontifying-it "should handle a keyword with allowed characters" + (":aaa#bbb" + (1 8 clojure-keyword-face))) + + (when-fontifying-it "should handle a keyword with disallowed characters" + (":aaa@bbb" + (1 5 various-faces)) + + (":aaa@bbb" + (1 4 clojure-keyword-face)) + + (":aaa~bbb" + (1 5 various-faces)) + + (":aaa~bbb" + (1 4 clojure-keyword-face)) + + (":aaa@bbb" + (1 5 various-faces)) + + (":aaa@bbb" + (1 4 clojure-keyword-face))) + + (when-fontifying-it "should handle characters" + ("\\a" + (1 2 clojure-character-face)) + + ("\\A" + (1 2 clojure-character-face)) + + ("\\newline" + (1 8 clojure-character-face)) + + ("\\abc" + (1 4 nil)) + + ("\\newlin" + (1 7 nil)) + + ("\\newlinex" + (1 9 nil)) + + ("\\1" + (1 2 clojure-character-face)) + + ("\\u0032" + (1 6 clojure-character-face)) + + ("\\o127" + (1 4 clojure-character-face)) + + ("\\+" + (1 2 clojure-character-face)) + + ("\\." + (1 2 clojure-character-face)) + + ("\\," + (1 2 clojure-character-face)) + + ("\\;" + (1 2 clojure-character-face)) + + ("\\Ω" + (1 2 clojure-character-face)) + + ("\\ク" + (1 2 clojure-character-face))) + + (when-fontifying-it "should handle characters not by themselves" + ("[\\,,]" + (1 1 nil) + (2 3 clojure-character-face) + (4 5 nil)) + + ("[\\[]" + (1 1 nil) + (2 3 clojure-character-face) + (4 4 nil))) + + (when-fontifying-it "should handle % character literal" + ("#(str \\% %)" + (7 8 clojure-character-face) + (10 10 font-lock-variable-name-face))) + + (when-fontifying-it "should handle referred vars" + ("foo/var" + (1 3 font-lock-type-face)) + + ("@foo/var" + (2 4 font-lock-type-face))) + + (when-fontifying-it "should handle dynamic vars" + ("*some-var*" + (1 10 font-lock-variable-name-face)) + + ("@*some-var*" + (2 11 font-lock-variable-name-face)) + + ("some.ns/*var*" + (9 13 font-lock-variable-name-face)) + + ("*some-var?*" + (1 11 font-lock-variable-name-face)))) + +(provide 'clojure-mode-font-lock-test) + +;;; clojure-mode-font-lock-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-indentation-test.el b/clojure-mode-tests/clojure-mode-indentation-test.el new file mode 100644 index 0000000..1a03656 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-indentation-test.el @@ -0,0 +1,839 @@ +;;; clojure-mode-indentation-test.el --- Clojure Mode: indentation tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: + +(require 'clojure-mode) +(require 'cl-lib) +(require 'buttercup) +(require 's nil t) ;Don't burp if it's missing during compilation. +(require 'test-helper "test/utils/test-helper") + +(defmacro when-indenting-with-point-it (description before after) + "Return a buttercup spec. + +Check whether the swift indentation command will correctly change the buffer. +Will also check whether point is moved to the expected position. + +BEFORE is the buffer string before indenting, where a pipe (|) represents +point. + +AFTER is the expected buffer string after indenting, where a pipe (|) +represents the expected position of point. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + `(it ,description + (let* ((after ,after) + (clojure-indent-style 'always-align) + (expected-cursor-pos (1+ (s-index-of "|" after))) + (expected-state (delete ?| after))) + (with-clojure-buffer ,before + (goto-char (point-min)) + (search-forward "|") + (delete-char -1) + (font-lock-ensure) + (indent-according-to-mode) + (expect (buffer-string) :to-equal expected-state) + (expect (point) :to-equal expected-cursor-pos))))) + +;; Backtracking indent +(defmacro when-indenting-it (description &optional style &rest forms) + "Return a buttercup spec. + +Check that all FORMS correspond to properly indented sexps. + +STYLE allows overriding the default clojure-indent-style 'always-align. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + (when (stringp style) + (setq forms (cons style forms)) + (setq style '(quote always-align))) + `(it ,description + (progn + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-mode) + (insert "\n" ,form);,(replace-regexp-in-string "\n +" "\n " form)) + (let ((clojure-indent-style ,style)) + (indent-region (point-min) (point-max))) + (expect (buffer-string) :to-equal ,(concat "\n" form)))) + forms)))) + +(defmacro when-aligning-it (description &rest forms) + "Return a buttercup spec. + +Check that all FORMS correspond to properly indented sexps. + +DESCRIPTION is a string with the description of the spec." + (declare (indent defun)) + `(it ,description + (let ((clojure-align-forms-automatically t) + (clojure-align-reader-conditionals t)) + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-mode) + (insert "\n" ,(replace-regexp-in-string " +" " " form)) + (indent-region (point-min) (point-max)) + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + ,(concat "\n" form))))) + forms)) + (let ((clojure-align-forms-automatically nil)) + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-mode) + (insert "\n" ,(replace-regexp-in-string " +" " " form)) + ;; This is to check that we did NOT align anything. Run + ;; `indent-region' and then check that no extra spaces + ;; where inserted besides the start of the line. + (indent-region (point-min) (point-max)) + (goto-char (point-min)) + (should-not (search-forward-regexp "\\([^\s\n]\\) +" nil 'noerror)))) + forms)))) + +;; Provide font locking for easier test editing. + +(font-lock-add-keywords + 'emacs-lisp-mode + `((,(rx "(" (group "when-indenting-with-point-it") eow) + (1 font-lock-keyword-face)) + (,(rx "(" + (group "when-indenting-with-point-it") (+ space) + (group bow (+ (not space)) eow) + ) + (1 font-lock-keyword-face) + (2 font-lock-function-name-face)))) + +(describe "indentation" + (it "should not hang on end of buffer" + (with-clojure-buffer "(let [a b]" + (goto-char (point-max)) + (expect + (with-timeout (2) + (newline-and-indent) + t)))) + + (when-indenting-with-point-it "should have no indentation at top level" + "|x" + + "|x") + + (when-indenting-with-point-it "should indent cond" + " + (cond + |x)" + + " + (cond + |x)") + + (when-indenting-with-point-it "should indent cond-> with a namespaced map" + " +(cond-> #:a{:b 1} +|x 1)" + + " +(cond-> #:a{:b 1} + |x 1)") + + (when-indenting-with-point-it "should indent cond-> with a namespaced map 2" + " +(cond-> #::a{:b 1} +|x 1)" + + " +(cond-> #::a{:b 1} + |x 1)") + + (when-indenting-with-point-it "should indent threading macro with expression on first line" + " + (->> expr + |ala)" + + " + (->> expr + |ala)") + + (when-indenting-with-point-it "should indent threading macro with expression on second line" + " + (->> + |expr)" + + " + (->> + |expr)") + + (when-indenting-with-point-it "should not indent for def string" + "(def foo \"hello|\")" + "(def foo \"hello|\")") + + (when-indenting-with-point-it "should indent doc strings" + " + (defn some-fn + |\"some doc string\")" + " + (defn some-fn + |\"some doc string\")") + + (when-indenting-with-point-it "should not indent doc strings when correct indent already specified" + " + (defn some-fn + |\"some doc string\")" + " + (defn some-fn + |\"some doc string\")") + + (when-indenting-with-point-it "should handle doc strings with additional indent specified" + " + (defn some-fn + |\"some doc string + - some note\")" + " + (defn some-fn + |\"some doc string + - some note\")") + + (describe "specify different indentation for symbol with some ns prefix" + (put-clojure-indent 'bala 0) + (put-clojure-indent 'ala/bala 1) + + (when-indenting-with-point-it "should handle a symbol without ns" + " + (bala + |one)" + " + (bala + |one)") + + (when-indenting-with-point-it "should handle a symbol with ns" + " + (ala/bala top + |one)" + " + (ala/bala top + |one)")) + + (describe "specify an indentation for symbol" + (put-clojure-indent 'cala 1) + + (when-indenting-with-point-it "should handle a symbol with ns" + " + (cala top + |one)" + " + (cala top + |one)") + (when-indenting-with-point-it "should handle special arguments" + " + (cala + |top + one)" + " + (cala + |top + one)")) + (describe "should respect special argument indentation" + :var (clojure-special-arg-indent-factor) + (before-each + (setq clojure-special-arg-indent-factor 1)) + (after-each + (setq clojure-special-arg-indent-factor 2)) + + (put-clojure-indent 'cala 1) + + (when-indenting-with-point-it "should handle a symbol with ns" + " + (cala top + |one)" + " + (cala top + |one)") + (when-indenting-with-point-it "should handle special arguments" + " + (cala + |top + one)" + " + (cala + |top + one)")) + + (describe "we can pass a lambda to explicitly set the column" + (put-clojure-indent 'arsymbol (lambda (_indent-point _state) 0)) + + (when-indenting-with-point-it "should handle a symbol with lambda" + " +(arsymbol +|one)" + " +(arsymbol +|one)")) + + (when-indenting-with-point-it "should indent a form with metadata" + " + (ns ^:doc app.core + |(:gen-class))" + " + (ns ^:doc app.core + |(:gen-class))") + + (when-indenting-with-point-it "should handle multiline sexps" + " + [[ + 2] a + |x]" + " + [[ + 2] a + |x]") + + (when-indenting-with-point-it "should indent reader conditionals" + " + #?(:clj :foo + |:cljs :bar)" + " + #?(:clj :foo + |:cljs :bar)") + + (when-indenting-with-point-it "should handle backtracking with aliases" + " + (clojure.core/letfn [(twice [x] + |(* x 2))] + :a)" + " + (clojure.core/letfn [(twice [x] + |(* x 2))] + :a)") + + (when-indenting-with-point-it "should handle fixed-normal-indent" + " + (cond + (or 1 + 2) 3 + |:else 4)" + + " + (cond + (or 1 + 2) 3 + |:else 4)") + + (when-indenting-with-point-it "should handle fixed-normal-indent-2" + " +(fact {:spec-type + :charnock-column-id} #{\"charnock\"} +|{:spec-type + :charnock-column-id} #{\"current_charnock\"})" + + " +(fact {:spec-type + :charnock-column-id} #{\"charnock\"} + |{:spec-type + :charnock-column-id} #{\"current_charnock\"})") + + (when-indenting-it "closing-paren" + " +(ns ca + (:gen-class) + )") + + (when-indenting-it "default-is-not-a-define" + " +(default a + b + b)" + " +(some.namespace/default a + b + b)") + + + (when-indenting-it "should handle extend-type with multiarity" + " +(extend-type Banana + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))" + + " +(extend-protocol Banana + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))") + + + (when-indenting-it "should handle deftype with multiarity" + " +(deftype Banana [] + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))") + + (when-indenting-it "should handle defprotocol" + " +(defprotocol IFoo + (foo [this] + \"Why is this over here?\") + (foo-2 + [this] + \"Why is this over here?\"))") + + + (when-indenting-it "should handle definterface" + " +(definterface IFoo + (foo [this] + \"Why is this over here?\") + (foo-2 + [this] + \"Why is this over here?\"))") + + (when-indenting-it "should handle specify" + " +(specify obj + ISwap + (-swap! + ([this f] (reset! this (f @this))) + ([this f a] (reset! this (f @this a))) + ([this f a b] (reset! this (f @this a b))) + ([this f a b xs] (reset! this (apply f @this a b xs)))))") + + (when-indenting-it "should handle specify!" + " +(specify! obj + ISwap + (-swap! + ([this f] (reset! this (f @this))) + ([this f a] (reset! this (f @this a))) + ([this f a b] (reset! this (f @this a b))) + ([this f a b xs] (reset! this (apply f @this a b xs)))))") + + (when-indenting-it "should handle non-symbol at start" + " +{\"1\" 2 + *3 4}") + + (when-indenting-it "should handle non-symbol at start 2" + " +(\"1\" 2 + *3 4)") + + (when-indenting-it "should handle defrecord" + " +(defrecord TheNameOfTheRecord + [a pretty long argument list] + SomeType + (assoc [_ x] + (.assoc pretty x 10)))") + + (when-indenting-it "should handle defrecord 2" + " +(defrecord TheNameOfTheRecord [a pretty long argument list] + SomeType (assoc [_ x] + (.assoc pretty x 10)))") + + (when-indenting-it "should handle defrecord with multiarity" + " +(defrecord Banana [] + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))") + + (when-indenting-it "should handle letfn" + " +(letfn [(f [x] + (* x 2)) + (f [x] + (* x 2))] + (a b + c) (d) + e)") + + (when-indenting-it "should handle reify" + " +(reify Object + (x [_] + 1))" + + " +(reify + om/IRender + (render [this] + (let [indent-test :fail] + ...)) + om/IRender + (render [this] + (let [indent-test :fail] + ...)))") + + (when-indenting-it "proxy" + " +(proxy [Writer] [] + (close [] (.flush ^Writer this)) + (write + ([x] + (with-out-binding [out messages] + (.write out x))) + ([x ^Integer off ^Integer len] + (with-out-binding [out messages] + (.write out x off len)))) + (flush [] + (with-out-binding [out messages] + (.flush out))))") + + (when-indenting-it "should handle reader conditionals" + "#?@ (:clj [] + :cljs [])") + + (when-indenting-it "should handle an empty close paren" + " +(let [x] + )" + + " +(ns ok + )" + + " +(ns ^{:zen :dikar} + ok + )") + + (when-indenting-it "should handle unfinished sexps" + " +(letfn [(tw [x] + dd") + + (when-indenting-it "should handle symbols ending in crap" + " +(msg? ExceptionInfo + 10)" + + " +(thrown-with-msg? ExceptionInfo + #\"Storage must be initialized before use\" + (f))" + + " +(msg' 1 + 10)") + + (when-indenting-it "should handle let, when and while forms" + "(let-alist [x 1]\n ())" + "(while-alist [x 1]\n ())" + "(when-alist [x 1]\n ())" + "(if-alist [x 1]\n ())" + "(indents-like-fn-when-let-while-if-are-not-the-start [x 1]\n ())") + +(defun indent-cond (indent-point state) + (goto-char (elt state 1)) + (let ((pos -1) + (base-col (current-column))) + (forward-char 1) + ;; `forward-sexp' will error if indent-point is after + ;; the last sexp in the current sexp. + (condition-case nil + (while (and (<= (point) indent-point) + (not (eobp))) + (clojure-forward-logical-sexp 1) + (cl-incf pos)) + ;; If indent-point is _after_ the last sexp in the + ;; current sexp, we detect that by catching the + ;; `scan-error'. In that case, we should return the + ;; indentation as if there were an extra sexp at point. + (scan-error (cl-incf pos))) + (+ base-col (if (cl-evenp pos) 0 2)))) +(put-clojure-indent 'test-cond #'indent-cond) + +(defun indent-cond-0 (_indent-point _state) 0) +(put-clojure-indent 'test-cond-0 #'indent-cond-0) + + + (when-indenting-it "should handle function spec" + " +(when me + (test-cond + x + 1 + 2 + 3))" + + " +(when me + (test-cond-0 +x +1 +2 +3))") + + (when-indenting-it "should respect indent style 'align-arguments" + 'align-arguments + + " +(some-function + 10 + 1 + 2)" + + " +(some-function 10 + 1 + 2)") + + (when-indenting-it "should respect indent style 'always-indent" + 'always-indent + + " +(some-function + 10 + 1 + 2)" + + " +(some-function 10 + 1 + 2)") + + (when-aligning-it "should basic forms" + " +{:this-is-a-form b + c d}" + + " +{:this-is b + c d}" + + " +{:this b + c d}" + + " +{:a b + c d}" + + " +(let [this-is-a-form b + c d])" + + " +(let [this-is b + c d])" + + " +(let [this b + c d])" + + " +(let [a b + c d])") + + (when-aligning-it "should handle a blank line" + " +(let [this-is-a-form b + c d + + another form + k g])" + + " +{:this-is-a-form b + c d + + :another form + k g}") + + (when-aligning-it "should handle basic forms (reversed)" + " +{c d + :this-is-a-form b}" + " +{c d + :this-is b}" + " +{c d + :this b}" + " +{c d + :a b}" + + " +(let [c d + this-is-a-form b])" + + " +(let [c d + this-is b])" + + " +(let [c d + this b])" + + " +(let [c d + a b])") + + (when-aligning-it "should handle incomplete sexps" + " +(cond aa b + casodkas )" + + " +(cond aa b + casodkas)" + + " +(cond aa b + casodkas " + + " +(cond aa b + casodkas" + + " +(cond aa b + casodkas a)" + + " +(cond casodkas a + aa b)" + + " +(cond casodkas + aa b)") + + + (when-aligning-it "should handle multiple words" + " +(cond this is just + a test of + how well + multiple words will work)") + + (when-aligning-it "should handle nested maps" + " +{:a {:a :a + :bbbb :b} + :bbbb :b}") + + (when-aligning-it "should regard end as a marker" + " +{:a {:a :a + :aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa :a} + :b {:a :a + :aa :a}}") + + (when-aligning-it "should handle trailing commas" + " +{:a {:a :a, + :aa :a}, + :b {:a :a, + :aa :a}}") + + (when-aligning-it "should handle standard reader conditionals" + " +#?(:clj 2 + :cljs 2)") + + (when-aligning-it "should handle splicing reader conditional" + " +#?@(:clj [2] + :cljs [2])") + + (when-aligning-it "should handle sexps broken up by line comments" + " +(let [x 1 + ;; comment + xx 1] + xx)" + + " +{:x 1 + ;; comment + :xxx 2}" + + " +(case x + :aa 1 + ;; comment + :a 2)") + + (when-aligning-it "should work correctly when margin comments appear after nested, multi-line, non-terminal sexps" + " +(let [x {:a 1 + :b 2} ; comment + xx 3] + x)" + + " +{:aa {:b 1 + :cc 2} ;; comment + :a 1}}" + + " +(case x + :a (let [a 1 + aa (+ a 1)] + aa); comment + :aa 2)") + + (it "should handle improperly indented content" + (let ((content "(let [a-long-name 10\nb 20])") + (aligned-content "(let [a-long-name 10\n b 20])")) + (with-clojure-buffer content + (call-interactively #'clojure-align) + (expect (buffer-string) :to-equal aligned-content)))) + + (it "should not align reader conditionals by default" + (let ((content "#?(:clj 2\n :cljs 2)")) + (with-clojure-buffer content + (call-interactively #'clojure-align) + (expect (buffer-string) :to-equal content)))) + + (it "should align reader conditionals when clojure-align-reader-conditionals is true" + (let ((content "#?(:clj 2\n :cljs 2)")) + (with-clojure-buffer content + (setq-local clojure-align-reader-conditionals t) + (call-interactively #'clojure-align) + (expect (buffer-string) :not :to-equal content)))) + + (it "should remove extra commas" + (with-clojure-buffer "{:a 2, ,:c 4}" + (call-interactively #'clojure-align) + (expect (string= (buffer-string) "{:a 2, :c 4}"))))) + +(provide 'clojure-mode-indentation-test) + +;;; clojure-mode-indentation-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-promote-fn-literal-test.el b/clojure-mode-tests/clojure-mode-promote-fn-literal-test.el new file mode 100644 index 0000000..13aa006 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-promote-fn-literal-test.el @@ -0,0 +1,73 @@ +;;; clojure-mode-promote-fn-literal-test.el --- Clojure Mode: convert fn syntax -*- lexical-binding: t; -*- + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Tests for clojure-promote-fn-literal + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-promote-fn-literal" + :var (names) + + (before-each + (spy-on 'read-string + :and-call-fake (lambda (_) (or (pop names) (error ""))))) + + (when-refactoring-it "should convert 0-arg fns" + "#(rand)" + "(fn [] (rand))" + (clojure-promote-fn-literal)) + + (when-refactoring-it "should convert 1-arg fns" + "#(= % 1)" + "(fn [x] (= x 1))" + (setq names '("x")) + (clojure-promote-fn-literal)) + + (when-refactoring-it "should convert 2-arg fns" + "#(conj (pop %) (assoc (peek %1) %2 (* %2 %2)))" + "(fn [acc x] (conj (pop acc) (assoc (peek acc) x (* x x))))" + (setq names '("acc" "x")) + (clojure-promote-fn-literal)) + + (when-refactoring-it "should convert variadic fns" + ;; from https://hypirion.com/musings/swearjure + "#(* (`[~@%&] (+)) + ((% (+)) % (- (`[~@%&] (+)) (*))))" + "(fn [v & vs] (* (`[~@vs] (+)) + ((v (+)) v (- (`[~@vs] (+)) (*)))))" + (setq names '("v" "vs")) + (clojure-promote-fn-literal)) + + (when-refactoring-it "should ignore strings and comments" + "#(format \"%2\" ;; FIXME: %2 is an illegal specifier + %7) " + "(fn [_ _ _ _ _ _ id] (format \"%2\" ;; FIXME: %2 is an illegal specifier + id)) " + (setq names '("_" "_" "_" "_" "_" "_" "id")) + (clojure-promote-fn-literal))) + + +(provide 'clojure-mode-convert-fn-test) + + +;;; clojure-mode-promote-fn-literal-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-add-arity-test.el b/clojure-mode-tests/clojure-mode-refactor-add-arity-test.el new file mode 100644 index 0000000..5f1c5fb --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-add-arity-test.el @@ -0,0 +1,328 @@ +;;; clojure-mode-refactor-add-arity.el --- Clojure Mode: refactor add arity -*- lexical-binding: t; -*- + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Commentary: + +;; Tests for clojure-add-arity + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-add-arity" + + (when-refactoring-with-point-it "should add an arity to a single-arity defn with args on same line" + "(defn foo [arg] + body|)" + + "(defn foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should add an arity to a single-arity defn with args on next line" + "(defn foo + [arg] + bo|dy)" + + "(defn foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defn with a docstring" + "(defn foo + \"some docst|ring\" + [arg] + body)" + + "(defn foo + \"some docstring\" + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defn with metadata" + "(defn fo|o + ^{:bla \"meta\"} + [arg] + body)" + + "(defn foo + ^{:bla \"meta\"} + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should add an arity to a multi-arity defn" + "(defn foo + ([arg1]) + ([ar|g1 arg2] + body))" + + "(defn foo + ([|]) + ([arg1]) + ([arg1 arg2] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defn with a docstring" + "(defn foo + \"some docstring\" + ([]) + ([arg|] + body))" + + "(defn foo + \"some docstring\" + ([|]) + ([]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defn with metadata" + "(defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([]) + |([arg] + body))" + + "(defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity fn" + "(fn foo [arg] + body|)" + + "(fn foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity fn" + "(fn foo + ([x y] + body) + ([a|rg] + body))" + + "(fn foo + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defmacro" + "(defmacro foo [arg] + body|)" + + "(defmacro foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defmacro" + "(defmacro foo + ([x y] + body) + ([a|rg] + body))" + + "(defmacro foo + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defmethod" + "(defmethod foo :bar [arg] + body|)" + + "(defmethod foo :bar + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defmethod" + "(defmethod foo :bar + ([x y] + body) + ([a|rg] + body))" + + "(defmethod foo :bar + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a defn inside a reader conditional" + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + |([arg] + body)))" + + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([arg] + body)))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a defn inside a reader conditional with 2 platform tags" + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + |([arg] + body)) + :cljs + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([arg] + body)))" + + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([arg] + body)) + :cljs + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([arg] + body)))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity fn inside a letfn" + "(letfn [(foo [x] + bo|dy)] + (foo 3))" + + "(letfn [(foo + ([|]) + ([x] + body))] + (foo 3))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity fn inside a letfn" + "(letfn [(foo + ([x] + body) + |([x y] + body))] + (foo 3))" + + "(letfn [(foo + ([|]) + ([x] + body) + ([x y] + body))] + (foo 3))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a proxy" + "(proxy [Foo] [] + (bar [arg] + body|))" + + "(proxy [Foo] [] + (bar + ([|]) + ([arg] + body)))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a defprotocol" + "(defprotocol Foo + \"some docstring\" + (bar [arg] [x |y] \"some docstring\"))" + + "(defprotocol Foo + \"some docstring\" + (bar [|] [arg] [x y] \"some docstring\"))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a reify" + "(reify Foo + (bar [arg] body) + (blahs [arg]| body))" + + "(reify Foo + (bar [arg] body) + (blahs [|]) + (blahs [arg] body))" + + (clojure-add-arity))) + +(provide 'clojure-mode-refactor-add-arity-test) + +;;; clojure-mode-refactor-add-arity-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-let-test.el b/clojure-mode-tests/clojure-mode-refactor-let-test.el new file mode 100644 index 0000000..a197012 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-let-test.el @@ -0,0 +1,259 @@ +;;; clojure-mode-refactor-let-test.el --- Clojure Mode: refactor let -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The refactor-let code originally was implemented in clj-refactor.el +;; and is the work of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure--introduce-let-internal" + (when-refactoring-it "should introduce a let form" + "{:status 200 + :body (find-body abc)}" + + "{:status 200 + :body (let [body (find-body abc)] + body)}" + + (search-backward "(find-body") + (clojure--introduce-let-internal "body")) + + (when-refactoring-it "should introduce an expanded let form" + "(defn handle-request [] + {:status 200 + :length (count (find-body abc)) + :body (find-body abc)})" + + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body}))" + + (search-backward "(find-body") + (clojure--introduce-let-internal "body" 1)) + + (when-refactoring-it "should replace bindings whitespace" + "(defn handle-request [] + {:status 200 + :length (count + (find-body + abc)) + :body (find-body abc)})" + + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count + body) + :body body}))" + (search-backward "(find-body") + (clojure--introduce-let-internal "body" 1))) + +(describe "clojure-let-forward-slurp-sexp" + (when-refactoring-it "should slurp the next 2 sexps after the let into the let form" + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body}) + (println (find-body abc)) + (println \"foobar\"))" + + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body} + (println body) + (println \"foobar\")))" + + (search-backward "(count body") + (clojure-let-forward-slurp-sexp 2))) + +(describe "clojure-let-backward-slurp-sexp" + (when-refactoring-it "should slurp the previous 2 sexps before the let into the let form" + "(defn handle-request [] + (println (find-body abc)) + (println \"foobar\") + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body}))" + + "(defn handle-request [] + (let [body (find-body abc)] + (println body) + (println \"foobar\") + {:status 200 + :length (count body) + :body body}))" + + (search-backward "(count body") + (clojure-let-backward-slurp-sexp 2))) + +(describe "clojure--move-to-let-internal" + (when-refactoring-it "should move sexp to let" + "(defn handle-request + (let [body (find-body abc)] + {:status (or status 500) + :body body}))" + + "(defn handle-request + (let [body (find-body abc) + status (or status 500)] + {:status status + :body body}))" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should move constant to when let" + "(defn handle-request + (when-let [body (find-body abc)] + {:status 42 + :body body}))" + + "(defn handle-request + (when-let [body (find-body abc) + status 42] + {:status status + :body body}))" + + (search-backward "42") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should move sexp to empty let" + "(defn handle-request + (if-let [] + {:status (or status 500) + :body body}))" + + "(defn handle-request + (if-let [status (or status 500)] + {:status status + :body body}))" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should introduce let if missing" + "(defn handle-request + {:status (or status 500) + :body body})" + + "(defn handle-request + {:status (let [status (or status 500)] + status) + :body body})" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should move multiple occurrences of a sexp" + "(defn handle-request + (let [] + (println \"body: \" body \", params: \" \", status: \" (or status 500)) + {:status (or status 500) + :body body}))" + + "(defn handle-request + (let [status (or status 500)] + (println \"body: \" body \", params: \" \", status: \" status) + {:status status + :body body}))" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should handle a name that is longer than the expression" + "(defn handle-request + (let [] + (println \"body: \" body \", params: \" \", status: \" 5) + {:body body + :status 5}))" + + "(defn handle-request + (let [status 5] + (println \"body: \" body \", params: \" \", status: \" status) + {:body body + :status status}))" + + (search-backward "5") + (search-backward "5") + (clojure--move-to-let-internal "status")) + + ;; clojure-emacs/clj-refactor.el#41 + (when-refactoring-it "should not move to nested let" + "(defn foo [] + (let [x (range 10)] + (doseq [x (range 10)] + (let [x2 (* x x)])) + (+ 1 1)))" + + "(defn foo [] + (let [x (range 10) + something (+ 1 1)] + (doseq [x x] + (let [x2 (* x x)])) + something))" + + (search-backward "(+ 1 1") + (clojure--move-to-let-internal "something")) + + ;; clojure-emacs/clj-refactor.el#30 + (when-refactoring-it "should move before current form when already inside let binding-1" + "(deftest retrieve-order-body-test + (let [item (get-in (retrieve-order-body order-item-response-str))]))" + + "(deftest retrieve-order-body-test + (let [something (retrieve-order-body order-item-response-str) + item (get-in something)]))" + + (search-backward "(retrieve") + (clojure--move-to-let-internal "something")) + + ;; clojure-emacs/clj-refactor.el#30 + (when-refactoring-it "should move before current form when already inside let binding-2" + "(let [parent (.getParent (io/file root adrf)) + builder (string-builder) + normalize-path (comp (partial path/relative-to root) + path/->normalized + foobar)] + (do-something-spectacular parent builder))" + + "(let [parent (.getParent (io/file root adrf)) + builder (string-builder) + something (partial path/relative-to root) + normalize-path (comp something + path/->normalized + foobar)] + (do-something-spectacular parent builder))" + + (search-backward "(partial") + (clojure--move-to-let-internal "something"))) + +(provide 'clojure-mode-refactor-let-test) + +;;; clojure-mode-refactor-let-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-rename-ns-alias-test.el b/clojure-mode-tests/clojure-mode-refactor-rename-ns-alias-test.el new file mode 100644 index 0000000..919a3cd --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-rename-ns-alias-test.el @@ -0,0 +1,175 @@ +;;; clojure-mode-refactor-rename-ns-alias-test.el --- Clojure Mode: refactor rename ns alias -*- lexical-binding: t; -*- + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Commentary: + +;; Tests for clojure-rename-ns-alias + +;;; Code: + +(require 'clojure-mode) +(require 'ert) + +(describe "clojure--rename-ns-alias-internal" + + (when-refactoring-it "should rename an alias" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def m #::lib{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as foo])) + + (def m #::foo{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (foo/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "lib" "foo")) + (when-refactoring-it "should handle multiple aliases with common prefixes" + + "(ns foo + (:require [clojure.string :as string] + [clojure.spec.alpha :as s] + [clojure.java.shell :as shell])) + +(s/def ::abc string/blank?) +" + "(ns foo + (:require [clojure.string :as string] + [clojure.spec.alpha :as spec] + [clojure.java.shell :as shell])) + +(spec/def ::abc string/blank?) +" + (clojure--rename-ns-alias-internal "s" "spec")) + + (when-refactoring-it "should handle ns declarations with missing as" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def m #::lib{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as lib])) + + (def m #::lib{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (lib/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "foo" "bar")) + + (when-refactoring-it "should skip strings" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as foo])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + (+ (foo/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "lib" "foo")) + + (when-refactoring-it "should not skip comments" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + ;; TODO refactor using lib/foo + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as new-lib])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + ;; TODO refactor using new-lib/foo + (+ (new-lib/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "lib" "new-lib")) + + (when-refactoring-it "should escape regex characters" + "(ns test.ns + (:require [my.math.subtraction :as math.-] + [my.math.multiplication :as math.*])) + +(math.*/operator 1 (math.-/subtract 2 3))" + "(ns test.ns + (:require [my.math.subtraction :as math.-] + [my.math.multiplication :as m*])) + +(m*/operator 1 (math.-/subtract 2 3))" + (clojure--rename-ns-alias-internal "math.*" "m*")) + + (when-refactoring-it "should replace aliases in region" + "(str/join []) + +(s/with-gen #(string/includes? % \"gen/nope\") + #(gen/fmap (fn [[s1 s2]] (str s1 \"hello\" s2)) + (gen/tuple (gen/string-alphanumeric) (gen/string-alphanumeric)))) + +(gen/different-library)" + "(string/join []) + +(s/with-gen #(string/includes? % \"gen/nope\") + #(s.gen/fmap (fn [[s1 s2]] (str s1 \"hello\" s2)) + (s.gen/tuple (s.gen/string-alphanumeric) (s.gen/string-alphanumeric)))) + +(gen/different-library)" + + (clojure--rename-ns-alias-usages "str" "string" (point-min) 13) + (clojure--rename-ns-alias-usages "gen" "s.gen" (point-min) (- (point-max) 23))) + + (it "should offer completions for ns forms" + (expect + (with-clojure-buffer + "(ns test.ns + (:require [my.math.subtraction :as math.-] + [my.math.multiplication :as math.*] + [clojure.spec.alpha :as s] + ;; [clojure.spec.alpha2 :as s2] + [symbols :as abc123.-$#.%*+!@])) + +(math.*/operator 1 (math.-/subtract 2 3))" + (clojure--collect-ns-aliases (point-min) (point-max) 'ns-form)) + :to-equal '("math.-" "math.*" "s" "abc123.-$#.%*+!@"))) + + (it "should offer completions for usages in region" + (expect + (with-clojure-buffer + "(s/with-gen #(string/includes? % \"hello\") + #(gen/fmap (fn [[s1 s2]] (str s1 \"hello\" s2)) + (gen/tuple (gen/string-alphanumeric) (gen/string-alphanumeric))))" + (clojure--collect-ns-aliases (point-min) (point-max) nil)) + :to-equal '("s" "string" "gen")))) + + +(provide 'clojure-mode-refactor-rename-ns-alias-test) + +;;; clojure-mode-refactor-rename-ns-alias-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-threading-test.el b/clojure-mode-tests/clojure-mode-refactor-threading-test.el new file mode 100644 index 0000000..efd7eb1 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-threading-test.el @@ -0,0 +1,465 @@ +;;; clojure-mode-refactor-threading-test.el --- Clojure Mode: refactor threading tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The threading refactoring code is ported from clj-refactor.el +;; and mainly the work of Magnar Sveen, Alex Baranosky and +;; the rest of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure-thread" + + (when-refactoring-it "should work with -> when performed once" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-thread)) + + (when-refactoring-it "should work with -> when performed twice" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread maps" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread last sexp" + "(-> (dissoc (assoc (get-a-map) :key \"value\") :lock))" + + "(-> (get-a-map) + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should thread-first-easy-on-whitespace" + "(-> + (dissoc (assoc {} :key \"value\") :lock))" + + "(-> + (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-thread)) + + (when-refactoring-it "should remove superfluous parens" + "(-> (square (sum [1 2 3 4 5])))" + + "(-> [1 2 3 4 5] + sum + square)" + + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should work with cursor before ->" + "(-> (not (s-acc/mobile? session)))" + + "(-> (s-acc/mobile? session) + not)" + + (beginning-of-buffer) + (clojure-thread)) + + (when-refactoring-it "should work with one step with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> (filter even? [1 2 3 4 5]) + (map square))" + + (clojure-thread)) + + (when-refactoring-it "should work with two steps with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread vectors with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread last sexp with ->>" + "(->> (map square (filter even? (get-a-list))))" + + "(->> (get-a-list) + (filter even?) + (map square))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should work with some->" + "(some-> (+ (val (find {:a 1} :b)) 5))" + + "(some-> {:a 1} + (find :b) + val + (+ 5))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should work with some->>" + "(some->> (+ 5 (val (find {:a 1} :b))))" + + "(some->> :b + (find {:a 1}) + val + (+ 5))" + + (clojure-thread) + (clojure-thread) + (clojure-thread))) + +(describe "clojure-unwind" + + (when-refactoring-it "should unwind -> one step" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(-> (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-unwind)) + + (when-refactoring-it "should unwind -> two steps" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind -> completely" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(dissoc (assoc {} :key \"value\") :lock)" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind ->> one step" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> (filter even? [1 2 3 4 5]) + (map square))" + + (clojure-unwind)) + + (when-refactoring-it "should unwind ->> two steps" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> (map square (filter even? [1 2 3 4 5])))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind ->> completely" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(map square (filter even? [1 2 3 4 5]))" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind N steps with numeric prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(->> (sum (map square (filter even? [1 2 3 4 5]))))" + + (clojure-unwind 3)) + + (when-refactoring-it "should unwind completely with universal prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(sum (map square (filter even? [1 2 3 4 5])))" + + (clojure-unwind '(4))) + + (when-refactoring-it "should unwind correctly when multiple ->> are present on same line" + "(->> 1 inc) (->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> 1 inc) (->> (map square (filter even? [1 2 3 4 5])))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind with function name" + "(->> [1 2 3 4 5] + sum + square)" + + "(->> (sum [1 2 3 4 5]) + square)" + + (clojure-unwind)) + + (when-refactoring-it "should unwind with function name twice" + "(-> [1 2 3 4 5] + sum + square)" + + "(-> (square (sum [1 2 3 4 5])))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should thread-issue-6-1" + "(defn plus [a b] + (-> a (+ b)))" + + "(defn plus [a b] + (-> (+ a b)))" + + (clojure-unwind)) + + (when-refactoring-it "should thread-issue-6-2" + "(defn plus [a b] + (->> a (+ b)))" + + "(defn plus [a b] + (->> (+ b a)))" + + (clojure-unwind)) + + (when-refactoring-it "should unwind some->" + "(some-> {:a 1} + (find :b) + val + (+ 5))" + + "(some-> (+ (val (find {:a 1} :b)) 5))" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind some->>" + "(some->> :b + (find {:a 1}) val + (+ 5))" + + "(some->> (+ 5 (val (find {:a 1} :b))))" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind))) + +(describe "clojure-thread-first-all" + + (when-refactoring-it "should thread first all sexps" + "(->map (assoc {} :key \"value\") :lock)" + + "(-> {} + (assoc :key \"value\") + (->map :lock))" + + (beginning-of-buffer) + (clojure-thread-first-all nil)) + + (when-refactoring-it "should thread a form except the last expression" + "(->map (assoc {} :key \"value\") :lock)" + + "(-> (assoc {} :key \"value\") + (->map :lock))" + + (beginning-of-buffer) + (clojure-thread-first-all t))) + +(describe "clojure-thread-last-all" + + (when-refactoring-it "should fully thread a form" + "(map square (filter even? (make-things)))" + + "(->> (make-things) + (filter even?) + (map square))" + + (beginning-of-buffer) + (clojure-thread-last-all nil)) + + (when-refactoring-it "should thread a form except the last expression" + "(map square (filter even? (make-things)))" + + "(->> (filter even? (make-things)) + (map square))" + + (beginning-of-buffer) + (clojure-thread-last-all t)) + + (when-refactoring-it "should handle dangling parens 1" + "(map inc + (range))" + + "(->> (range) + (map inc))" + + (beginning-of-buffer) + (clojure-thread-last-all nil)) + + (when-refactoring-it "should handle dangling parens 2" + "(deftask dev [] + (comp (serve) + (cljs)))" + + "(->> (cljs) + (comp (serve)) + (deftask dev []))" + + (beginning-of-buffer) + (clojure-thread-last-all nil))) + +(describe "clojure-unwind-all" + + (when-refactoring-it "should unwind all in ->" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(dissoc (assoc {} :key \"value\") :lock)" + + (beginning-of-buffer) + (clojure-unwind-all)) + + (when-refactoring-it "should unwind all in ->>" + "(->> (make-things) + (filter even?) + (map square))" + + "(map square (filter even? (make-things)))" + + (beginning-of-buffer) + (clojure-unwind-all)) + + ;; fix for clojure-emacs/clj-refactor.el#259 + (when-refactoring-it "should leave multiline sexp alone" + "(->> [a b] + (some (fn [x] + (when x + 10))))" + + "(some (fn [x] + (when x + 10)) + [a b])" + + (clojure-unwind-all)) + + (when-refactoring-it "should thread-last-maybe-unjoin-lines" + "(deftask dev [] + (comp (serve) + (cljs (lala) + 10)))" + + "(deftask dev [] + (comp (serve) + (cljs (lala) + 10)))" + + (goto-char (point-min)) + (clojure-thread-last-all nil) + (clojure-unwind-all))) + +(describe "clojure-thread-first-all" + + (when-refactoring-it "should thread with an empty first line" + "(map + inc + [1 2])" + + "(-> inc + (map + [1 2]))" + + (goto-char (point-min)) + (clojure-thread-first-all nil)) + + (when-refactoring-it "should thread-first-maybe-unjoin-lines" + "(map + inc + [1 2])" + + "(map + inc + [1 2])" + + (goto-char (point-min)) + (clojure-thread-first-all nil) + (clojure-unwind-all))) + +(provide 'clojure-mode-refactor-threading-test) + +;;; clojure-mode-refactor-threading-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-safe-eval-test.el b/clojure-mode-tests/clojure-mode-safe-eval-test.el new file mode 100644 index 0000000..fe1e2a6 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-safe-eval-test.el @@ -0,0 +1,74 @@ +;;; clojure-mode-safe-eval-test.el --- Clojure Mode: safe eval test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov +;; Copyright (C) 2021 Rob Browning + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The safe eval test suite of Clojure Mode + +;;; Code: +(require 'clojure-mode) +(require 'buttercup) + +(describe "put-clojure-indent safe-local-eval-function property" + (it "should be set to clojure--valid-put-clojure-indent-call-p" + (expect (get 'put-clojure-indent 'safe-local-eval-function) + :to-be 'clojure--valid-put-clojure-indent-call-p))) + +(describe "clojure--valid-put-clojure-indent-call-p" + (it "should approve valid forms" + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo 1))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo :defn))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo :form))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(:defn)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(:form)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1 1)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(2 :form :form (1)))))) + (it "should reject invalid forms" + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 1 1)) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo :foo)) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo (:defn))) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(:foo))) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1 :foo))) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1 "foo"))) + :to-throw 'error))) + +(provide 'clojure-mode-safe-eval-test) + +;;; clojure-mode-safe-eval-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-sexp-test.el b/clojure-mode-tests/clojure-mode-sexp-test.el new file mode 100644 index 0000000..11bf519 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-sexp-test.el @@ -0,0 +1,233 @@ +;;; clojure-mode-sexp-test.el --- Clojure Mode: sexp tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2021 Artur Malabarba + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure-top-level-form-p" + (it "should return true when passed the correct form" + (with-clojure-buffer-point + "(comment + (wrong) + (rig|ht) + (wrong))" + ;; make this use the native beginning of defun since this is used to + ;; determine whether to use the comment aware version or not. + (expect (let ((beginning-of-defun-function nil)) + (clojure-top-level-form-p "comment"))))) + (it "should return true when multiple forms are present" + (with-clojure-buffer-point + "(+ 1 2) (comment + (wrong) + (rig|ht) + (wrong))" + (expect (let ((beginning-of-defun-function nil)) + (clojure-top-level-form-p "comment")))))) +(describe "clojure--looking-at-top-level-form" + (it "should return nil when point is inside a top level form" + (with-clojure-buffer-point + "(comment + |(ns foo))" + (expect (clojure--looking-at-top-level-form) :to-equal nil)) + (with-clojure-buffer-point + "\"|(ns foo)\"" + (expect (clojure--looking-at-top-level-form) :to-equal nil)) + (with-clojure-buffer-point + "^{:fake-ns |(ns foo)}" + (expect (clojure--looking-at-top-level-form) :to-equal nil))) + (it "should return true when point is looking at a top level form" + (with-clojure-buffer-point + "(comment + |(ns foo))" + (expect (clojure--looking-at-top-level-form (point-min)) :to-equal t)) + (with-clojure-buffer-point + "|(ns foo)" + (expect (clojure--looking-at-top-level-form) :to-equal t)))) +(describe "clojure-beginning-of-defun-function" + (it "should go to top level form" + (with-clojure-buffer-point + " (comment + (wrong) + (wrong) + (rig|ht) + (wrong))" + (clojure-beginning-of-defun-function) + (expect (looking-at-p "(comment")))) + + (it "should eval top level forms inside comment forms when clojure-toplevel-inside-comment-form set to true" + (with-clojure-buffer-point + "(+ inc 1) (comment + (wrong) + (wrong) (rig|ht) + (wrong))" + (let ((clojure-toplevel-inside-comment-form t)) + (clojure-beginning-of-defun-function)) + (expect (looking-at-p "(right)")))) + + (it "should go to beginning of previous top level form" + (with-clojure-buffer-point + " +(formA) +| +(formB)" + (let ((clojure-toplevel-inside-comment-form t)) + (beginning-of-defun) + (expect (looking-at-p "(formA)"))))) + + (it "should move forward to next top level form" + (with-clojure-buffer-point + " +(first form) +| +(second form) + +(third form)" + + (end-of-defun) + (backward-char) + (expect (looking-back "(second form)"))))) + +(describe "clojure-forward-logical-sexp" + (it "should work with commas" + (with-clojure-buffer "[], {}, :a, 2" + (goto-char (point-min)) + (clojure-forward-logical-sexp 1) + (expect (looking-at-p " {}, :a, 2")) + (clojure-forward-logical-sexp 1) + (expect (looking-at-p " :a, 2"))))) + +(describe "clojure-backward-logical-sexp" + (it "should work when used in conjunction with clojure-forward-logical-sexp" + (with-clojure-buffer "^String #macro ^dynamic reverse" + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "\\^String \\#macro \\^dynamic reverse")) + (clojure-forward-logical-sexp 1) + (expect (looking-back "\\^String \\#macro \\^dynamic reverse")) + (insert " ^String biverse inverse") + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "inverse")) + (clojure-backward-logical-sexp 2) + (expect (looking-at-p "\\^String \\#macro \\^dynamic reverse")) + (clojure-forward-logical-sexp 2) + (expect (looking-back "\\^String biverse")) + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "\\^String biverse")))) + + (it "should handle a namespaced map" + (with-clojure-buffer "first #:name/space{:k v}" + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "#:name/space{:k v}")) + (insert " #::ns {:k v}") + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "#::ns {:k v}"))))) + +(describe "clojure-backward-logical-sexp" + (it "should work with buffer corners" + (with-clojure-buffer "^String reverse" + ;; Return nil and don't error + (expect (clojure-backward-logical-sexp 100) :to-be nil) + (expect (looking-at-p "\\^String reverse")) + (expect (clojure-forward-logical-sexp 100) :to-be nil) + (expect (looking-at-p "$"))) + (with-clojure-buffer "(+ 10" + (expect (clojure-backward-logical-sexp 100) :to-throw 'error) + (goto-char (point-min)) + (expect (clojure-forward-logical-sexp 100) :to-throw 'error) + ;; Just don't hang. + (goto-char (point-max)) + (expect (clojure-forward-logical-sexp 1) :to-be nil) + (erase-buffer) + (insert "(+ 10") + (newline) + (erase-buffer) + (insert "(+ 10") + (newline-and-indent)))) + +(describe "clojure-find-ns" + (it "should return the namespace from various locations in the buffer" + ;; we should not cache the results of `clojure-find-ns' here + (let ((clojure-cache-ns nil)) + (with-clojure-buffer "(ns ^{:doc \"Some docs\"}\nfoo-bar)" + (newline) + (newline) + (insert "(in-ns 'baz-quux)") + + ;; From inside docstring of first ns + (goto-char 18) + (expect (clojure-find-ns) :to-equal "foo-bar") + + ;; From inside first ns's name, on its own line + (goto-char 29) + (expect (clojure-find-ns) :to-equal "foo-bar") + + ;; From inside second ns's name + (goto-char 42) + (expect (equal "baz-quux" (clojure-find-ns)))) + (let ((data + '(("\"\n(ns foo-bar)\"\n" "(in-ns 'baz-quux)" "baz-quux") + (";(ns foo-bar)\n" "(in-ns 'baz-quux2)" "baz-quux2") + ("(ns foo-bar)\n" "\"\n(in-ns 'baz-quux)\"" "foo-bar") + ("(ns foo-bar2)\n" ";(in-ns 'baz-quux)" "foo-bar2")))) + (pcase-dolist (`(,form1 ,form2 ,expected) data) + (with-clojure-buffer form1 + (save-excursion (insert form2)) + ;; Between the two namespaces + (expect (clojure-find-ns) :to-equal expected) + ;; After both namespaces + (goto-char (point-max)) + (expect (clojure-find-ns) :to-equal expected)))))) + + (describe "`suppress-errors' argument" + (let ((clojure-cache-ns nil)) + (describe "given a faulty ns form" + (let ((ns-form "(ns )")) + (describe "when the argument is `t'" + (it "causes `clojure-find-ns' to return nil" + (with-clojure-buffer ns-form + (expect (equal nil (clojure-find-ns t)))))) + + (describe "when the argument is `nil'" + (it "causes `clojure-find-ns' to return raise an error" + (with-clojure-buffer ns-form + (expect (clojure-find-ns nil) + :to-throw 'error))))))))) + +(describe "clojure-sexp-starts-until-position" + (it "should return starting points for forms after POINT until POSITION" + (with-clojure-buffer "(run 1) (def b 2) (slurp \"file\")\n" + (goto-char (point-min)) + (expect (not (cl-set-difference '(19 9 1) + (clojure-sexp-starts-until-position (point-max))))))) + + (it "should return starting point for a single form in buffer after POINT" + (with-clojure-buffer "comment\n" + (goto-char (point-min)) + (expect (not (cl-set-difference '(1) + (clojure-sexp-starts-until-position (point-max))))))) + + (it "should return nil if POSITION is behind POINT" + (with-clojure-buffer "(run 1) (def b 2)\n" + (goto-char (point-max)) + (expect (not (clojure-sexp-starts-until-position (- (point-max) 1))))))) + +(provide 'clojure-mode-sexp-test) + +;;; clojure-mode-sexp-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-syntax-test.el b/clojure-mode-tests/clojure-mode-syntax-test.el new file mode 100644 index 0000000..dfe2505 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-syntax-test.el @@ -0,0 +1,193 @@ +;;; clojure-mode-syntax-test.el --- Clojure Mode: syntax related tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(defun non-func (form-a form-b) + (with-clojure-buffer form-a + (save-excursion (insert form-b)) + (clojure--not-function-form-p))) + +(describe "clojure--not-function-form-p" + (it "should handle forms that are not funcions" + (dolist (form '(("#?@ " "(c d)") + ("#?@" "(c d)") + ("#? " "(c d)") + ("#?" "(c d)") + ("" "[asda]") + ("" "{a b}") + ("#" "{a b}") + ("" "(~)"))) + (expect (apply #'non-func form)))) + + (it "should handle forms that are funcions" + (dolist (form '("(c d)" + "(.c d)" + "(:c d)" + "(c/a d)" + "(.c/a d)" + "(:c/a d)" + "(c/a)" + "(:c/a)" + "(.c/a)")) + (expect (non-func "" form) :to-be nil) + (expect (non-func "^hint" form) :to-be nil) + (expect (non-func "#macro" form) :to-be nil) + (expect (non-func "^hint " form) :to-be nil) + (expect (non-func "#macro " form) :to-be nil)))) + +(describe "clojure-match-next-def" + (let ((some-sexp "\n(list [1 2 3])")) + (it "handles vars with metadata" + (dolist (form '("(def ^Integer a 1)" + "(def ^:a a 1)" + "(def ^::a a 1)" + "(def ^::a/b a 1)" + "(def ^{:macro true} a 1)")) + (with-clojure-buffer (concat form some-sexp) + (end-of-buffer) + (clojure-match-next-def) + (expect (looking-at "(def"))))) + + (it "handles vars without metadata" + (with-clojure-buffer (concat "(def a 1)" some-sexp) + (end-of-buffer) + (clojure-match-next-def) + (expect (looking-at "(def")))) + + (it "handles invalid def forms" + (dolist (form '("(def ^Integer)" + "(def)" + "(def ^{:macro})" + "(def ^{:macro true})" + "(def ^{:macro true} foo)" + "(def ^{:macro} foo)")) + (with-clojure-buffer (concat form some-sexp) + (end-of-buffer) + (clojure-match-next-def) + (expect (looking-at "(def")))))) + + (it "captures var name" + (dolist (form '("(def some-name 1)" + "(def some-name)" + "(def ^:private some-name 2)" + "(def ^{:private true} some-name 3)")) + (with-clojure-buffer form + (end-of-buffer) + (clojure-match-next-def) + (cl-destructuring-bind (name-beg name-end) (match-data) + (expect (string= "some-name" (buffer-substring name-beg name-end))))))) + + (it "captures var name with dispatch value for defmethod" + (dolist (form '("(defmethod some-name :key [a])" + "(defmethod ^:meta some-name :key [a])" + "(defmethod ^{:meta true} some-name :key [a])" + "(defmethod some-name :key)")) + (with-clojure-buffer form + (end-of-buffer) + (clojure-match-next-def) + (cl-destructuring-bind (name-beg name-end) (match-data) + (expect (string= "some-name :key" (buffer-substring name-beg name-end)))))))) + +(describe "clojure syntax" + (it "handles prefixed symbols" + (dolist (form '(("#?@aaa" . "aaa") + ("#?aaa" . "?aaa") + ("#aaa" . "aaa") + ("'aaa" . "aaa"))) + (with-clojure-buffer (car form) + ;; FIXME: Shouldn't there be an `expect' here? + (equal (symbol-name (symbol-at-point)) (cdr form))))) + + (it "skips prefixes" + (dolist (form '("#?@aaa" "#?aaa" "#aaa" "'aaa")) + (with-clojure-buffer form + (backward-word) + (backward-prefix-chars) + (expect (bobp)))))) + +(describe "fill-paragraph" + + (it "should work within comments" + (with-clojure-buffer " +;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt +;; ut labore et dolore magna aliqua." + (goto-char (point-min)) + (let ((fill-column 80)) + (fill-paragraph)) + (expect (buffer-string) :to-equal " +;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod +;; tempor incididunt ut labore et dolore magna aliqua."))) + + (it "should work within inner comments" + (with-clojure-buffer " +(let [a 1] + ;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt + ;; ut labore et dolore + ;; magna aliqua. + )" + (goto-char (point-min)) + (forward-line 2) + (let ((fill-column 80)) + (fill-paragraph)) + (expect (buffer-string) :to-equal " +(let [a 1] + ;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod + ;; tempor incididunt ut labore et dolore magna aliqua. + )"))) + +(when (fboundp 'font-lock-ensure) + (it "should not alter surrounding code" + (with-clojure-buffer "(def my-example-variable + \"It has a very long docstring. So long, in fact, that it wraps onto multiple lines! This is to demonstrate what happens when the docstring wraps over three lines.\" + nil)" + (font-lock-ensure) + (goto-char 40) + (let ((clojure-docstring-fill-column 80) + (fill-column 80)) + (fill-paragraph)) + (expect (buffer-string) :to-equal "(def my-example-variable + \"It has a very long docstring. So long, in fact, that it wraps onto multiple + lines! This is to demonstrate what happens when the docstring wraps over three + lines.\" + nil)"))))) + +(when (fboundp 'font-lock-ensure) + (describe "clojure-in-docstring-p" + (it "should handle def with docstring" + (with-clojure-buffer "(def my-example-variable + \"Doc here and `doc-here`\" + nil)" + (font-lock-ensure) + (goto-char 32) + (expect (clojure-in-docstring-p)) + (goto-char 46) + (expect (clojure-in-docstring-p)))))) + +(provide 'clojure-mode-syntax-test) + +;;; clojure-mode-syntax-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-util-test.el b/clojure-mode-tests/clojure-mode-util-test.el new file mode 100644 index 0000000..78a2ac1 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-util-test.el @@ -0,0 +1,336 @@ +;;; clojure-mode-util-test.el --- Clojure Mode: util test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: +(require 'clojure-mode) +(require 'cl-lib) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-mode-version" + (it "should not be nil" + (expect clojure-mode-version))) + +(defvar clojure-cache-project) + +(let ((project-dir "/home/user/projects/my-project/") + (clj-file-path "/home/user/projects/my-project/src/clj/my_project/my_ns/my_file.clj") + (project-relative-clj-file-path "src/clj/my_project/my_ns/my_file.clj") + (clj-file-ns "my-project.my-ns.my-file") + (clojure-cache-project nil)) + + (describe "clojure-project-root-path" + (it "nbb subdir" + (with-temp-dir temp-dir + (let* ((bb-edn (expand-file-name "nbb.edn" temp-dir)) + (bb-edn-src (expand-file-name "src" temp-dir))) + (write-region "{}" nil bb-edn) + (make-directory bb-edn-src) + (expect (expand-file-name (clojure-project-dir bb-edn-src)) + :to-equal (file-name-as-directory temp-dir)))))) + + (describe "clojure-project-relative-path" + (cl-letf (((symbol-function 'clojure-project-dir) (lambda () project-dir))) + (expect (string= (clojure-project-relative-path clj-file-path) + project-relative-clj-file-path)))) + + (describe "clojure-expected-ns" + (it "should return the namespace matching a path" + (cl-letf (((symbol-function 'clojure-project-relative-path) + (lambda (&optional _current-buffer-file-name) + project-relative-clj-file-path))) + (expect (string= (clojure-expected-ns clj-file-path) clj-file-ns)))) + + (it "should return the namespace even without a path" + (cl-letf (((symbol-function 'clojure-project-relative-path) + (lambda (&optional _current-buffer-file-name) + project-relative-clj-file-path))) + (expect (string= (let ((buffer-file-name clj-file-path)) + (clojure-expected-ns)) + clj-file-ns)))))) + +(describe "clojure-find-ns" + (it "should find common namespace declarations" + (with-clojure-buffer "(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns + foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns foo.baz)" + (expect (clojure-find-ns) :to-equal "foo.baz")) + (with-clojure-buffer "(ns ^:bar foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns ^:bar ^:baz foo)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should find namespaces with spaces before ns form" + (with-clojure-buffer " (ns foo)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should skip namespaces within any comment forms" + (with-clojure-buffer "(comment + (ns foo))" + (expect (clojure-find-ns) :to-equal nil)) + (with-clojure-buffer " (ns foo) + (comment + (ns bar))" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer " (comment + (ns foo)) + (ns bar) + (comment + (ns baz))" + (expect (clojure-find-ns) :to-equal "bar"))) + (it "should find namespace declarations with nested metadata and docstrings" + (with-clojure-buffer "(ns ^{:bar true} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns #^{:bar true} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns #^{:fail {}} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns ^{:fail2 {}} foo.baz)" + (expect (clojure-find-ns) :to-equal "foo.baz")) + (with-clojure-buffer "(ns ^{} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns ^{:skip-wiki true} + aleph.netty" + (expect (clojure-find-ns) :to-equal "aleph.netty")) + (with-clojure-buffer "(ns ^{:foo {:bar :baz} :fake (ns in.meta)} foo + \"docstring +(ns misleading)\")" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should support non-alphanumeric characters" + (with-clojure-buffer "(ns foo+)" + (expect (clojure-find-ns) :to-equal "foo+")) + (with-clojure-buffer "(ns bar**baz$-_quux)" + (expect (clojure-find-ns) :to-equal "bar**baz$-_quux")) + (with-clojure-buffer "(ns aoc-2019.puzzles.day14)" + (expect (clojure-find-ns) :to-equal "aoc-2019.puzzles.day14"))) + (it "should support in-ns forms" + (with-clojure-buffer "(in-ns 'bar.baz)" + (expect (clojure-find-ns) :to-equal "bar.baz"))) + (it "should take the closest ns before point" + (with-clojure-buffer " (ns foo1) + +(ns foo2)" + (expect (clojure-find-ns) :to-equal "foo2")) + (with-clojure-buffer " (in-ns foo1) +(ns 'foo2) +(in-ns 'foo3) +| +(ns foo4)" + (re-search-backward "|") + (expect (clojure-find-ns) :to-equal "foo3")) + (with-clojure-buffer "(ns foo) +(ns-unmap *ns* 'map) +(ns.misleading 1 2 3)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should skip leading garbage" + (with-clojure-buffer " (ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "1(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "1 (ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "1 +(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "[1] +(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "[1] (ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "[1](ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns)(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns )(ns foo)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should ignore carriage returns" + (with-clojure-buffer "(ns \r\n foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns\r\n ^{:doc \"meta\r\n\"}\r\n foo\r\n)" + (expect (clojure-find-ns) :to-equal "foo")))) + +(describe "clojure-sort-ns" + (it "should sort requires in a basic ns" + (with-clojure-buffer "(ns my-app.core + (:require [rum.core :as rum] ;comment + [my-app.views [user-page :as user-page]]))" + (clojure-sort-ns) + (expect (buffer-string) :to-equal + "(ns my-app.core + (:require [my-app.views [user-page :as user-page]] + [rum.core :as rum] ;comment +))"))) + + (it "should sort requires in a basic ns with comments in the end" + (with-clojure-buffer "(ns my-app.core + (:require [rum.core :as rum] ;comment + [my-app.views [user-page :as user-page]] + ;;[comment2] +))" + (clojure-sort-ns) + (expect (buffer-string) :to-equal + "(ns my-app.core + (:require [my-app.views [user-page :as user-page]] + [rum.core :as rum] ;comment + + ;;[comment2] +))"))) + (it "should sort requires in ns with copyright disclamer and comments" + (with-clojure-buffer ";; Copyright (c) John Doe. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (https://opensource.org/license/epl-1-0/) +(ns clojure.core + (:require + ;; The first comment + [foo] ;; foo comment + ;; Middle comment + [bar] ;; bar comment + ;; A last comment + ))" + (clojure-sort-ns) + (expect (buffer-string) :to-equal + ";; Copyright (c) John Doe. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (https://opensource.org/license/epl-1-0/) +(ns clojure.core + (:require + ;; Middle comment + [bar] ;; bar comment + ;; The first comment + [foo] ;; foo comment + + ;; A last comment + ))"))) + + (it "should also sort imports in a ns" + (with-clojure-buffer "\n(ns my-app.core + (:require [my-app.views [front-page :as front-page]] + [my-app.state :refer [state]] ; Comments too. + ;; Some comments. + [rum.core :as rum] + [my-app.views [user-page :as user-page]] + my-app.util.api) + (:import java.io.Writer + [clojure.lang AFunction Atom MultiFn Namespace]))" + (clojure-mode) + (clojure-sort-ns) + (expect (buffer-string) :to-equal + "\n(ns my-app.core + (:require [my-app.state :refer [state]] ; Comments too. + my-app.util.api + [my-app.views [front-page :as front-page]] + [my-app.views [user-page :as user-page]] + ;; Some comments. + [rum.core :as rum]) + (:import [clojure.lang AFunction Atom MultiFn Namespace] + java.io.Writer))")))) + +(describe "clojure-toggle-ignore" + (when-refactoring-with-point-it "should add #_ to literals" + "[1 |2 3]" "[1 #_|2 3]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should work with point in middle of symbol" + "[foo b|ar baz]" "[foo #_b|ar baz]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should remove #_ after cursor" + "[1 |#_2 3]" "[1 |2 3]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should remove #_ before cursor" + "[#_:fo|o :bar :baz]" "[:fo|o :bar :baz]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should insert multiple #_" + "{:foo| 1 :bar 2 :baz 3}" + "{#_#_#_#_:foo| 1 :bar 2 :baz 3}" + (clojure-toggle-ignore 4)) + (when-refactoring-with-point-it "should remove multiple #_" + "{#_#_#_#_:foo| 1 :bar 2 :baz 3}" + "{#_#_:foo| 1 :bar 2 :baz 3}" + (clojure-toggle-ignore 2)) + (when-refactoring-with-point-it "should handle spaces and newlines" + "[foo #_ \n #_ \r\n b|ar baz]" "[foo b|ar baz]" + (clojure-toggle-ignore 2)) + (when-refactoring-with-point-it "should toggle entire string" + "[:div \"lorem ips|um text\"]" + "[:div #_\"lorem ips|um text\"]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should toggle regexps" + "[|#\".*\"]" + "[#_|#\".*\"]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should toggle collections" + "[foo |[bar baz]]" + "[foo #_|[bar baz]]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should toggle hash sets" + "[foo #|{bar baz}]" + "[foo #_#|{bar baz}]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should work on last-sexp" + "[foo '(bar baz)| quux]" + "[foo #_'(bar baz)| quux]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should insert newline before top-level form" + "|[foo bar baz]" + "#_ +|[foo bar baz]" + (clojure-toggle-ignore))) + +(describe "clojure-toggle-ignore-surrounding-form" + (when-refactoring-with-point-it "should toggle lists" + "(li|st [vector {map #{set}}])" + "#_\n(li|st [vector {map #{set}}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should toggle vectors" + "(list #_[vector| {map #{set}}])" + "(list [vector| {map #{set}}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should toggle maps" + "(list [vector #_ \n {map #{set}|}])" + "(list [vector {map #{set}|}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should toggle sets" + "(list [vector {map #{set|}}])" + "(list [vector {map #_#{set|}}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should work with numeric arg" + "(four (three (two (on|e)))" + "(four (three #_(two (on|e)))" + (clojure-toggle-ignore-surrounding-form 2)) + (when-refactoring-with-point-it "should remove #_ with numeric arg" + "(four #_(three (two (on|e)))" + "(four (three (two (on|e)))" + (clojure-toggle-ignore-surrounding-form 3))) + +(describe "clojure-toggle-ignore-defun" + (when-refactoring-with-point-it "should ignore defun with newline" + "(defn foo [x] + {:nested (in|c x)})" + "#_ +(defn foo [x] + {:nested (in|c x)})" + (clojure-toggle-ignore-defun))) + +(provide 'clojure-mode-util-test) + +;;; clojure-mode-util-test.el ends here diff --git a/test/test-helper.el b/test/test-helper.el index 3866003..cb0a2ad 100644 --- a/test/test-helper.el +++ b/test/test-helper.el @@ -55,4 +55,56 @@ attention to case differences." (let ((case-fold-search ignore-case)) (string-match-p (regexp-quote needle) s))) +(defmacro when-refactoring-it (description before after &rest body) + "Return a buttercup spec. + +Insert BEFORE into a buffer, evaluate BODY and compare the resulting buffer to +AFTER. + +BODY should contain the refactoring that transforms BEFORE into AFTER. + +DESCRIPTION is the description of the spec." + (declare (indent 1)) + `(it ,description + (with-clojure-ts-buffer ,before + ,@body + (expect (buffer-string) :to-equal ,after)))) + +(defmacro when-refactoring-with-point-it (description before after &rest body) + "Return a buttercup spec. + +Like when-refactor-it but also checks whether point is moved to the expected +position. + +BEFORE is the buffer string before refactoring, where a pipe (|) represents +point. + +AFTER is the expected buffer string after refactoring, where a pipe (|) +represents the expected position of point. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + `(it ,description + (let* ((after ,after) + (expected-cursor-pos (1+ (clojure-ts--s-index-of "|" after))) + (expected-state (delete ?| after))) + (with-clojure-ts-buffer ,before + (goto-char (point-min)) + (search-forward "|") + (delete-char -1) + ,@body + (expect (buffer-string) :to-equal expected-state) + (expect (point) :to-equal expected-cursor-pos))))) + + +;; https://emacs.stackexchange.com/a/55031 +(defmacro with-temp-dir (temp-dir &rest body) + "Create a temporary directory and bind its to TEMP-DIR while evaluating BODY. +Removes the temp directory at the end of evaluation." + `(let ((,temp-dir (make-temp-file "" t))) + (unwind-protect + (progn + ,@body) + (delete-directory ,temp-dir t)))) + ;;; test-helper.el ends here