Allow Functions for :test-dir

CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## master (unreleased)
 
+### New features
+
+* [#1671](https://github.com/bbatsov/projectile/pull/1671) Allow the `:test-dir` option of a project to be set to a function for more flexible test switching.
+
 ### Bugs fixed
 
 * [#1673](https://github.com/bbatsov/projectile/issues/1673): Fix CMake system-preset filename.
@@ -10,7 +14,7 @@
 
 ### New features
 
-* Add `projectile-update-project-type-function` for updating the properties of existing project types.
+* Add `projectile-update-project-type` function for updating the properties of existing project types.
 * [#1658](https://github.com/bbatsov/projectile/pull/1658): New command `projectile-reset-known-projects`.
 * [#1656](https://github.com/bbatsov/projectile/pull/1656): Add support for CMake configure, build and test presets. Enabled by setting `projectile-cmake-presets` to non-nil, disabled by default.
 

doc/modules/ROOT/pages/projects.adoc

@@ -237,7 +237,7 @@ Bellow is a listing of all the available options for `projectile-register-projec
 | A command to test the project.
 
 | :test-dir
-| A path, relative to the project root, where the test code lives.
+| A path, relative to the project root, where the test code lives.  A function may also be specified which takes one parameter - the directory of a file, and it should return the directory in which the test file should reside.
 
 | :test-prefix
 | A prefix to generate test files names.
@@ -294,15 +294,23 @@ Note that your function has to return a string to work properly.
 
 === Related file location
 
-For simple projects, `:test-prefix` and `:test-suffix` option with string will
-be enough to specify test prefix/suffix applicable regardless of file extensions
-on any directory path. `projectile-other-file-alist` variable can be also set to
-find other files based on the extension.
+The `:test-prefix` and `:test-suffix` will work regardless of file extension
+or directory path should and be enough for simple projects.  The
+`projectile-other-file-alist` variable can also be set to find other files
+based on the extension.
 
-For the full control of finding related files, `:related-files-fn` option with a
-custom function or a list of custom functions can be used. The custom function
-accepts the relative file name from the project root and it should return the
-related file information as plist with the following optional key/value pairs:
+For fine-grained control of implementation/test toggling, the `:test-dir` option
+of a project may take a function of one parameter (the implementation
+directory absolute path) and return the directory of the test file. This in
+conjunction with the options `:test-prefix` and `:test-suffix` will then be
+used to determine the full path of the test file. This option will always be
+respected if it is set.
+
+Alternatively, for flexible file switching accross a range of projects,
+the `:related-files-fn` option set to a custom function or a
+list of custom functions can be used. The custom function accepts the relative
+file name from the project root and it should return related file information
+as a plist with the following optional key/value pairs:
 
 |===
 | Key | Value | Command applicable
@@ -346,6 +354,8 @@ of a function can be fast as it does not iterate over each source file.
 . There is a difference in behaviour between no key and `nil` value for the
 key. Only when the key does not exist, other project options such as
 `:test_prefix` or `projectile-other-file-alist` mechanism is tried.
+. If the `:test-dir` option is set to a function, this will take precedence over
+any value for `:related-files-fn` set when `projectile-toggle-between-implementation-and-test` is called.
 
 ==== Example - Same source file name for test and impl
 
@@ -447,15 +457,44 @@ You can also edit specific options of already existing project types:
 [source,elisp]
 ----
 (projectile-update-project-type
-   'sbt
-   :related-files-fn
-   (list
-    (projectile-related-files-fn-test-with-suffix "scala" "Spec")
-    (projectile-related-files-fn-test-with-suffix "scala" "Test")))
+ 'sbt
+ :related-files-fn
+ (list
+  (projectile-related-files-fn-test-with-suffix "scala" "Spec")
+  (projectile-related-files-fn-test-with-suffix "scala" "Test")))
 ----
 
 This will keep all existing options for the `sbt` project type, but change the value of the `related-files-fn` option.
 
+
+=== `:test-dir` vs `:related-files-fn`
+
+The `:test-dir` option is useful if the test location for a given implementation
+file is almost always going to be in the same place accross all projects
+belonging to a given project type, `maven` projects are an example of this:
+
+[source,elisp]
+----
+(projectile-update-project-type
+ 'maven
+ :test-dir
+ (lambda (file-path) (projectile-complementary-dir file-path "main" "test")))
+----
+
+If instead you work on a lot of elisp projects using `eldev`, the
+`:related-files-fn` option may be more appropriate since the test locations tend
+to vary accross projects:
+
+[source,elisp]
+----
+(projectile-update-project-type
+ 'emacs-eldev
+ :related-files-fn
+ (list
+  (projectile-related-files-fn-test-with-suffix "el" "-test")
+  (projectile-related-files-fn-test-with-prefix "el" "test-")))
+----
+
 == Customizing Project Detection
 
 Project detection is pretty simple - Projectile just runs a list of

projectile.el

@@ -3311,19 +3311,42 @@ PROJECT-ROOT is the targeted directory.  If nil, use
      (test-suffix (concat impl-file-name test-suffix "." impl-file-ext))
      (t (error "Project type `%s' not supported!" project-type)))))
 
-(defun projectile-create-test-file-for (impl-file-path)
-  "Create a test file for IMPL-FILE-PATH."
-  (let* ((test-file (projectile--test-name-for-impl-name impl-file-path))
-         (project-root (projectile-project-root))
-         (relative-dir (file-name-directory (file-relative-name impl-file-path project-root)))
-         (src-dir-name (projectile-src-directory (projectile-project-type)))
-         (test-dir-name (projectile-test-directory (projectile-project-type)))
-         (test-dir (expand-file-name (replace-regexp-in-string src-dir-name test-dir-name relative-dir) project-root))
-         (test-path (expand-file-name test-file test-dir)))
-    (unless (file-exists-p test-path)
-      (progn (unless (file-exists-p test-dir)
-               (make-directory test-dir :create-parents))
-             test-path))))
+(defun projectile--impl-to-test-dir (impl-dir-path)
+  "Return the directory path of a test whose impl file resides in IMPL-DIR-PATH.
+
+Occurrences of the current project type's src-dir property (which should be a
+string) are replaced with the current project type's test-dir property
+ (which should be a string) to obtain the new directory.
+
+An error is signalled if either the src-dir or test-dir properties are not
+strings."
+  (let ((test-dir (projectile-test-directory (projectile-project-type)))
+        (impl-dir (projectile-src-directory (projectile-project-type))))
+    (if (and (stringp test-dir) (stringp impl-dir))
+        (projectile-complementary-dir impl-dir-path impl-dir test-dir)
+      (error "Expected the current project's :test-dir and :impl-dir properties to be strings but found %s and %s" test-dir impl-dir))))
+
+(defun projectile-complementary-dir (dir-path string replacement)
+  "Return the \"complementary\" directory of DIR-PATH by replacing STRING in DIR-PATH with REPLACEMENT."
+  (let* ((project-root (projectile-project-root))
+         (relative-dir (file-name-directory (file-relative-name dir-path project-root))))
+    (projectile-expand-root
+     (replace-regexp-in-string string replacement relative-dir))))
+
+(defun projectile--create-directories-for (path)
+  "Create directories necessary for PATH."
+  (unless (file-exists-p path)
+    (make-directory (if (file-directory-p path)
+                        path
+                      (file-name-directory path))
+                    :create-parents)))
+
+(defun projectile--test-file-fallback (file-name)
+  "Attempt to build a path for the test file of FILE-NAME using the src-dir and test-dir properties of the current project type which should be strings, an error is signalled if this is not the case."
+  (projectile--complementary-file
+   file-name
+   #'projectile--impl-to-test-dir
+   #'projectile--test-name-for-impl-name))
 
 (defun projectile-find-implementation-or-test (file-name)
   "Given a FILE-NAME return the matching implementation or test filename.
@@ -3340,13 +3363,15 @@ test file."
            "No matching source file found for project type `%s'"
            (projectile-project-type))))
     ;; find the matching test file
-    (let ((test-file (projectile-find-matching-test file-name)))
-      (if test-file
-          (projectile-expand-root test-file)
-        (if projectile-create-missing-test-files
-            (projectile-create-test-file-for file-name)
-          (error "No matching test file found for project type `%s'"
-                 (projectile-project-type)))))))
+    (let* ((test-file (projectile-find-matching-test file-name))
+           (test-file-or-fallback (or test-file (projectile--test-file-fallback file-name)))
+           (expanded-test-file (projectile-expand-root test-file-or-fallback)))
+      (cond ((file-exists-p expanded-test-file) expanded-test-file)
+            (projectile-create-missing-test-files
+             (projectile--create-directories-for expanded-test-file)
+             expanded-test-file)
+            (t (error "No matching test file found for project type `%s'"
+                      (projectile-project-type)))))))
 
 ;;;###autoload
 (defun projectile-find-implementation-or-test-other-window ()
@@ -3441,13 +3466,37 @@ Fallback to DEFAULT-VALUE for missing attributes."
         (or (string-equal prefix-name name)
             (string-equal suffix-name name))))))
 
+(defun projectile--complementary-file (file-path dir-fn filename-fn)
+  "Apply DIR-FN and FILENAME-FN to the directory and name of FILE-PATH.
+
+More specifically, return DIR-FN applied to the directory of FILE-PATH
+concatenated with FILENAME-FN applied to the file name of FILE-PATH."
+  (let* ((filename (file-name-nondirectory file-path))
+         (complementary-filename (funcall filename-fn filename))
+         (dir (funcall dir-fn (file-name-directory file-path))))
+    (concat (file-name-as-directory dir) complementary-filename)))
+
+(defun projectile--test-file-from-test-dir-fn (impl-file)
+  "Return the test file path for the absolute path IMPL-FILE relative to the project root, in the case the current project type's test-dir has been set to a custom function, else return nil."
+  (when-let ((test-dir (projectile-test-directory (projectile-project-type))))
+    (when (functionp test-dir)
+      (file-relative-name
+       (projectile--complementary-file
+        impl-file
+        test-dir
+        #'projectile--test-name-for-impl-name)
+       (projectile-project-root)))))
+
 (defun projectile--find-matching-test (impl-file)
   "Return a list of test files for IMPL-FILE."
-  (if-let ((plist (projectile--related-files-plist-by-kind impl-file :test)))
-      (projectile--related-files-from-plist plist)
-    (if-let ((predicate (projectile--impl-to-test-predicate impl-file)))
+  (if-let ((test-file-from-test-dir-fn
+            (projectile--test-file-from-test-dir-fn impl-file)))
+      (list test-file-from-test-dir-fn)
+    (if-let ((plist (projectile--related-files-plist-by-kind impl-file :test)))
+        (projectile--related-files-from-plist plist)
+      (when-let ((predicate (projectile--impl-to-test-predicate impl-file)))
         (projectile--best-or-all-candidates-based-on-parents-dirs
-         impl-file (cl-remove-if-not predicate (projectile-current-project-files))))))
+         impl-file (cl-remove-if-not predicate (projectile-current-project-files)))))))
 
 (defun projectile--test-to-impl-predicate (test-file)
   "Return a predicate, which returns t for any impl files for TEST-FILE."

test/projectile-test.el

@@ -1212,7 +1212,22 @@ Just delegates OPERATION and ARGS for all operations except for`shell-command`'.
         (expect (projectile-test-file-p "src/Foo.cpp") :to-equal nil)
         (expect (projectile--find-matching-test "src/Foo.cpp") :to-equal '("test/Foo.cpp"))
         (expect (projectile--find-matching-test "src/Foo.cpp") :to-equal '("test/Foo.cpp"))
-        (expect (projectile--find-matching-file "test/Foo.cpp") :to-equal '("src/Foo.cpp"))))))
+        (expect (projectile--find-matching-file "test/Foo.cpp") :to-equal '("src/Foo.cpp")))))
+
+  (it "defers to test-dir property when it's set to a function"
+    (projectile-test-with-sandbox
+     (projectile-test-with-files-using-custom-project
+          ("src/foo/Foo.cpp"
+           "src/bar/Foo.cpp"
+           "src/foo/FooTest.cpp")
+          (:test-dir
+           (lambda (file-path)
+             (projectile-complementary-dir file-path "src" "test"))
+           :test-suffix "Test")
+          (expect (projectile--find-matching-test
+                   (projectile-expand-root "src/bar/Foo.cpp"))
+                  :to-equal
+                  (list "test/bar/FooTest.cpp"))))))
 
 (describe "projectile--related-files"
   (it "returns related files for the given file"
@@ -1657,6 +1672,68 @@ projectile-process-current-project-buffers-current to have similar behaviour"
         (projectile-process-current-project-buffers-current (lambda () (push (current-buffer) list-b)))
         (expect list-a :to-equal list-b))))))
 
+(describe "projectile-find-implementation-or-test"
+  (it "error when test file does not exist and projectile-create-missing-test-files is nil"
+    (cl-letf (((symbol-function 'projectile-test-file-p) #'ignore)
+              ((symbol-function 'file-exists-p) #'ignore)
+              ((symbol-function 'projectile-expand-root) #'identity)
+              ((symbol-function 'projectile-find-matching-test) (lambda (file) "dir/foo"))
+              (projectile-create-missing-test-files nil))
+      (expect (projectile-find-implementation-or-test "foo") :to-throw))))
+
+(describe "projectile--test-file-from-test-dir-fn"
+  :var ((mock-projectile-project-types
+         '((foo test-dir (lambda (impl-file) "/outer/foo/test/dir"))
+           (bar test-dir "not a function"))))
+  (it "returns result of projectile--complementary-file when test-dir property is a function"
+    (cl-letf (((symbol-function 'projectile--complementary-file)
+               (lambda (impl-file dir-fn file-fn) (funcall dir-fn impl-file)))
+              ((symbol-function 'projectile-project-type) (lambda () 'foo))
+              ((symbol-function 'projectile-project-root) (lambda () "foo"))
+              ((symbol-function 'file-relative-name) (lambda (f rel) f))
+              (projectile-project-types mock-projectile-project-types))
+      (expect (projectile--test-file-from-test-dir-fn "foo") :to-equal "/outer/foo/test/dir")))
+  (it "returns file relative to project root"
+    (cl-letf (((symbol-function 'projectile-project-type) (lambda () 'foo))
+              ((symbol-function 'projectile-project-root) (lambda () "/outer/foo"))
+              ((symbol-function 'projectile--complementary-file)
+               (lambda (impl-file dir-fn file-fn) (funcall dir-fn impl-file)))
+              (projectile-project-types mock-projectile-project-types))
+      (expect (projectile--test-file-from-test-dir-fn "/outer/foo/bar")
+              :to-equal
+              "test/dir")))
+  (it "returns nil when test-dir property is a not function"
+    (cl-letf (((symbol-function 'projectile-project-type) (lambda () 'bar))
+              (projectile-project-types mock-projectile-project-types)
+              ((symbol-function 'projectile-project-root) (lambda () "foo")))
+      (expect (projectile--test-file-from-test-dir-fn "bar") :to-equal nil))))
+
+(describe "projectile--complementary-file"
+  (it "dir-fn and filename-fn applied correctly"
+    (cl-letf (((symbol-function 'file-exists-p) (lambda (file) t))
+              ((symbol-function 'dir-fn) (lambda (dir) "foo/test/dir"))
+              ((symbol-function 'filename-fn) (lambda (filename) "Foo.test")))
+      (expect (projectile--complementary-file
+               "foo/src/dir/Foo.impl"
+               #'dir-fn
+               #'filename-fn)
+              :to-equal "foo/test/dir/Foo.test"))))
+
+(describe "projectile--impl-to-test-dir"
+    :var ((mock-projectile-project-types
+           '((foo test-dir "test" src-dir "src")
+             (bar test-dir identity src-dir "src"))))
+    (it "replaces occurrences of src-dir with test-dir"
+      (cl-letf (((symbol-function 'projectile-project-root) (lambda () "foo"))
+                ((symbol-function 'projectile-project-type) (lambda () 'foo))
+                (projectile-project-types mock-projectile-project-types))
+        (expect (projectile--impl-to-test-dir "/foo/src/Foo") :to-equal "/foo/test/")))
+    (it "error signalled when test dir property is not a string"
+      (cl-letf (((symbol-function 'projectile-project-root) (lambda () "bar"))
+                ((symbol-function 'projectile-project-type) (lambda () 'bar))
+                (projectile-project-types mock-projectile-project-types))
+        (expect (projectile--impl-to-test-dir "/bar/src/bar") :to-throw))))
+
 ;; A bunch of tests that make sure Projectile commands handle
 ;; gracefully the case of being run outside of a project.
 (assert-friendly-error-when-no-project projectile-project-info)