Make projectile--find-matching-test Use src-dir/test-dir Properties

doc/modules/ROOT/pages/projects.adoc

@@ -483,35 +483,55 @@ This will keep all existing options for the `sbt` project type, but change the v
 
 === `:test-dir`/`:src-dir` vs `:related-files-fn`
 
-Setting the `:test-dir` and `:src-dir` options to functions is useful if the
-test location for a given implementation file is almost always going to be in
-the same place across all projects belonging to a given project type, `maven`
-projects are an example of this:
+Whilst setting the `:test-dir` and `:src-dir` to strings is sufficient for most
+purposes, using functions can give more flexibility.  As an example consider
+(also using `f.el`):
 
 [source,elisp]
 ----
+(defun my-get-python-test-file (impl-file-path)
+  "Return the corresponding test file directory for IMPL-FILE-PATH"
+  (let* ((rel-path (f-relative impl-file-path (projectile-project-root)))
+         (src-dir (car (f-split rel-path))))
+    (cond ((f-exists-p (f-join (projectile-project-root) "test"))
+           (projectile-complementary-dir impl-file-path src-dir "test"))
+          ((f-exists-p (f-join (projectile-project-root) "tests"))
+           (projectile-complementary-dir impl-file-path src-dir "tests"))
+          (t (error "Could not locate a test file for %s!" impl-file-path)))))
+
+(defun my-get-python-impl-file (test-file-path)
+  "Return the corresponding impl file directory for TEST-FILE-PATH"
+  (if-let* ((root (projectile-project-root))
+            (rel-path (f-relative test-file-path root))
+            (src-dir-guesses `(,(f-base root) ,(downcase (f-base root)) "src"))
+            (src-dir (cl-find-if (lambda (d) (f-exists-p (f-join root d)))
+                                 src-dir-guesses)))
+      (projectile-complementary-dir test-file-path "tests?" src-dir)
+    (error "Could not locate a impl file for %s!" test-file-path)))
+
 (projectile-update-project-type
- 'maven
- :src-dir
- (lambda (file-path) (projectile-complementary-dir file-path "test" "main"))
- :test-dir
- (lambda (file-path) (projectile-complementary-dir file-path "main" "test")))
+ 'python-pkg
+ :src-dir #'my-get-python-impl-dir
+ :test-dir #'my-get-python-test-dir)
 ----
 
-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 across projects:
+This attempts to recognise projects using both `test` and `tests` as top level
+directories for test files. An alternative using the `related-files-fn` option
+could be:
 
 [source,elisp]
 ----
 (projectile-update-project-type
- 'emacs-eldev
+ 'python-pkg
  :related-files-fn
  (list
-  (projectile-related-files-fn-test-with-suffix "el" "-test")
-  (projectile-related-files-fn-test-with-prefix "el" "test-")))
+  (projectile-related-files-fn-test-with-suffix "py" "_test")
+  (projectile-related-files-fn-test-with-prefix "py" "test_")))
 ----
 
+In fact this is a lot more flexible in terms of finding test files in different
+locations, but will not create test files for you.
+
 == Customizing Project Detection
 
 Project detection is pretty simple - Projectile just runs a list of

projectile.el

@@ -3133,6 +3133,8 @@ a manual COMMAND-TYPE command is created with
 ;; Scala
 (projectile-register-project-type 'sbt '("build.sbt")
                                   :project-file "build.sbt"
+                                  :src-dir "main"
+                                  :test-dir "test"
                                   :compile "sbt compile"
                                   :test "sbt test"
                                   :test-suffix "Spec")
@@ -3377,20 +3379,35 @@ TEST-FILE-PATH may be a absolute path, relative path or a file name."
       (concat (string-remove-suffix test-suffix test-file-name) "." test-file-ext))
      (t (error "Project type `%s' not supported!" project-type)))))
 
+(defun projectile--test-to-impl-dir (test-dir-path)
+  "Return the directory path of an impl file with test file in TEST-DIR-PATH.
+
+Occurrences of the current project type's test-dir property (which should be a
+string) are replaced with the current project type's src-dir property
+ (which should be a string) to obtain the new directory.
+
+Nil is returned if either the src-dir or test-dir properties are not strings."
+  (let ((test-dir (projectile-project-type-attribute
+                   (projectile-project-type) 'test-dir))
+        (impl-dir (projectile-project-type-attribute
+                   (projectile-project-type) 'src-dir)))
+    (when (and (stringp test-dir) (stringp impl-dir))
+      (projectile-complementary-dir test-dir-path test-dir impl-dir))))
+
 (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))))
+Nil is returned if either the src-dir or test-dir properties are not strings."
+  (let ((test-dir (projectile-project-type-attribute
+                   (projectile-project-type) 'test-dir))
+        (impl-dir (projectile-project-type-attribute
+                   (projectile-project-type) 'src-dir)))
+    (when (and (stringp test-dir) (stringp impl-dir))
+      (projectile-complementary-dir impl-dir-path impl-dir test-dir))))
 
 (defun projectile-complementary-dir (dir-path string replacement)
   "Return the \"complementary\" directory of DIR-PATH by replacing STRING in DIR-PATH with REPLACEMENT."
@@ -3407,19 +3424,13 @@ strings."
                       (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.
 
 If `projectile-create-missing-test-files' is non-nil, create the missing
 test file."
   (unless file-name (error "The current buffer is not visiting a file"))
+  (unless (projectile-project-type) (projectile-ensure-project nil))
   (if (projectile-test-file-p file-name)
       ;; find the matching impl file
       (let ((impl-file (projectile-find-matching-file file-name)))
@@ -3429,15 +3440,17 @@ 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))
-           (test-file-or-fallback (or test-file (projectile--test-file-fallback file-name)))
-           (expanded-test-file (projectile-expand-root test-file-or-fallback)))
+    (let* ((error-msg (format
+                       "No matching test file found for project type `%s'"
+                       (projectile-project-type)))
+           (test-file (or (projectile-find-matching-test file-name)
+                          (error error-msg)))
+           (expanded-test-file (projectile-expand-root test-file)))
       (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)))))))
+            (t (progn (error error-msg)))))))
 
 ;;;###autoload
 (defun projectile-find-implementation-or-test-other-window ()
@@ -3536,11 +3549,29 @@ Fallback to DEFAULT-VALUE for missing attributes."
   "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)))
+concatenated with FILENAME-FN applied to the file name of FILE-PATH.
+
+If either function returns nil, return nil."
+  (let ((filename (file-name-nondirectory file-path)))
+    (when-let ((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--impl-file-from-src-dir-str (file-name)
+  "Return a path relative to the project root for the impl file of FILE-NAME using the src-dir and test-dir properties of the current project type which should be strings, nil returned if this is not the case."
+  (when-let ((complementary-file (projectile--complementary-file
+                                  file-name
+                                  #'projectile--test-to-impl-dir
+                                  #'projectile--impl-name-for-test-name)))
+    (file-relative-name complementary-file (projectile-project-root))))
+
+(defun projectile--test-file-from-test-dir-str (file-name)
+  "Return a path relative to the project root for the test file of FILE-NAME using the src-dir and test-dir properties of the current project type which should be strings, nil returned if this is not the case."
+  (when-let (complementary-file (projectile--complementary-file
+                                 file-name
+                                 #'projectile--impl-to-test-dir
+                                 #'projectile--test-name-for-impl-name))
+    (file-relative-name complementary-file (projectile-project-root))))
 
 (defun projectile--impl-file-from-src-dir-fn (test-file)
   "Return the implementation file path for the absolute path TEST-FILE relative to the project root in the case the current project type's src-dir has been set to a custom function, return nil if this is not the case or the path points to a file that does not exist."
@@ -3565,15 +3596,25 @@ concatenated with FILENAME-FN applied to the file name of FILE-PATH."
        (projectile-project-root)))))
 
 (defun projectile--find-matching-test (impl-file)
-  "Return a list of test files for IMPL-FILE."
+  "Return a list of test files for IMPL-FILE.
+
+The precendence for determining test files to return is:
+
+1. Use the project type's test-dir property if it's set to a function
+2. Use the project type's related-files-fn property if set
+3. Use the project type's test-dir property if it's set to a string
+4. Default to a fallback which matches all project files against
+   `projectile--impl-to-test-predicate'"
   (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)))))))
+      (if-let ((test-file (projectile--test-file-from-test-dir-str impl-file)))
+          (list test-file)
+        (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))))))))
 
 (defun projectile--test-to-impl-predicate (test-file)
   "Return a predicate, which returns t for any impl files for TEST-FILE."
@@ -3586,15 +3627,25 @@ concatenated with FILENAME-FN applied to the file name of FILE-PATH."
             (when test-suffix (string-equal (concat name test-suffix) basename)))))))
 
 (defun projectile--find-matching-file (test-file)
-  "Return a list of impl files tested by TEST-FILE."
+  "Return a list of impl files tested by TEST-FILE.
+
+The precendence for determining implementation files to return is:
+
+1. Use the project type's src-dir property if it's set to a function
+2. Use the project type's related-files-fn property if set
+3. Use the project type's src-dir property if it's set to a string
+4. Default to a fallback which matches all project files against
+   `projectile--test-to-impl-predicate'"
   (if-let ((impl-file-from-src-dir-fn
             (projectile--impl-file-from-src-dir-fn test-file)))
       (list impl-file-from-src-dir-fn)
     (if-let ((plist (projectile--related-files-plist-by-kind test-file :impl)))
         (projectile--related-files-from-plist plist)
-      (if-let ((predicate (projectile--test-to-impl-predicate test-file)))
+      (if-let ((impl-file (projectile--impl-file-from-src-dir-str test-file)))
+          (list impl-file)
+        (when-let ((predicate (projectile--test-to-impl-predicate test-file)))
           (projectile--best-or-all-candidates-based-on-parents-dirs
-           test-file (cl-remove-if-not predicate (projectile-current-project-files)))))))
+           test-file (cl-remove-if-not predicate (projectile-current-project-files))))))))
 
 (defun projectile--choose-from-candidates (candidates)
   "Choose one item from CANDIDATES."

test/projectile-test.el

@@ -1163,8 +1163,23 @@ Just delegates OPERATION and ARGS for all operations except for`shell-command`'.
            "spec/foo/foo.service.spec.js"
            "spec/bar/bar.service.spec.js")
           (:test-suffix ".spec" :test-dir "spec/" :src-dir "source/")
-        (expect (projectile--find-matching-test "source/foo/foo.service.js") :to-equal '("spec/foo/foo.service.spec.js"))
-        (expect (projectile--find-matching-file "spec/bar/bar.service.spec.js") :to-equal '("source/bar/bar.service.js")))))
+        (expect (projectile--find-matching-test
+                 "project/source/foo/foo.service.js")
+                :to-equal '("spec/foo/foo.service.spec.js"))
+        (expect (projectile--find-matching-file
+                 "project/spec/bar/bar.service.spec.js")
+                :to-equal '("source/bar/bar.service.js")))))
+
+  (it "finds matching test with dirs and inexistent test file"
+    (projectile-test-with-sandbox
+      (projectile-test-with-files-using-custom-project
+          ("project/src/main/scala/bar/package.scala"
+           "project/src/main/scala/foo/package.scala"
+           "project/src/test/scala/foo/packageSpec.scala")
+          (:test-suffix "Spec" :test-dir "test" :src-dir "main")
+        (expect (projectile--find-matching-test
+                 "project/src/main/scala/bar/package.scala")
+                :to-equal '("src/test/scala/bar/packageSpec.scala")))))
 
   (it "finds matching test or file based on the paths returned by :related-files-fn option"
     (defun -my/related-files(file)
@@ -1721,7 +1736,8 @@ projectile-process-current-project-buffers-current to have similar behaviour"
               ((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))
+              (projectile-create-missing-test-files nil)
+              (projectile-project-type 'foo))
       (expect (projectile-find-implementation-or-test "foo") :to-throw))))
 
 (describe "projectile--impl-file-from-src-dir-fn"
@@ -1808,11 +1824,26 @@ projectile-process-current-project-buffers-current to have similar behaviour"
                 ((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"
+    (it "nil returned 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-be nil))))
+
+(describe "projectile--test-to-impl-dir"
+    :var ((mock-projectile-project-types
+           '((foo test-dir "test" src-dir "src")
+             (bar test-dir "test" src-dir identity))))
+    (it "replaces occurrences of test-dir with src-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--test-to-impl-dir "/foo/test/Foo") :to-equal "/foo/src/")))
+    (it "nil returned when src-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))))
+        (expect (projectile--test-to-impl-dir "/bar/test/bar") :to-be nil))))
 
 (describe "projectile-run-shell-command-in-root"
   (describe "when called directly in elisp"