Projectile-project-type could return the wrong project type when called with argument

CHANGELOG.md

@@ -31,6 +31,10 @@
 
 ### Bugs fixed
 
+* [#1806](https://github.com/bbatsov/projectile/pull/1806): Fix `projectile-project-type` to return the correct project type even when we pass it the DIR arg. As a result of the fix,
+`projectile-expand-root`, `projectile-detect-project-type`, `projectile-verify-files` , `projectile-verify-file` `projectile-verify-file-wildcard`, `projectile-cabal-project-p`, 
+`projectile-dotnet-project-p`, `projectile-go-project-p` and the newly factored out `projectile-eldev-project-p` now also takes an &optional DIR arg to specify the directory it is acting on.
+Added new tests for the bug and changes.
 * [#1781](https://github.com/bbatsov/projectile/pull/1781): Fix `rails-rspec` and `rails-test` to use `app` instead of `lib` as `src-dir`.
 * [#1762](https://github.com/bbatsov/projectile/pull/1762): Fix `projectile-globally-ignored-directories` unescaped regex.
 * [#1713](https://github.com/bbatsov/projectile/issues/1731): Fix `projectile-discover-projects-in-directory` reordering known projects.

projectile.el

@@ -1980,12 +1980,14 @@ prefix the string will be assumed to be an ignore string."
             (mapcar #'string-trim
                     (delete "" (reverse ensure)))))))
 
-(defun projectile-expand-root (name)
+(defun projectile-expand-root (name &optional dir)
   "Expand NAME to project root.
+When DIR is specified it uses DIR's project, otherwise it acts
+on the current project.
 
 Never use on many files since it's going to recalculate the
 project-root for every file."
-  (expand-file-name name (projectile-project-root)))
+  (expand-file-name name (projectile-project-root dir)))
 
 (cl-defun projectile-completing-read (prompt choices &key initial-input action)
   "Present a project tailored PROMPT with CHOICES."
@@ -2938,20 +2940,33 @@ files such as test/impl/other files as below:
                           (t (error "Precedence must be one of '(high low)"))))
                 (mapcar #'project-map projectile-project-types))))))
 
-(defun projectile-cabal-project-p ()
-  "Check if a project contains *.cabal files but no stack.yaml file."
-  (and (projectile-verify-file-wildcard "?*.cabal")
-       (not (projectile-verify-file "stack.yaml"))))
-
-(defun projectile-dotnet-project-p ()
-  "Check if a project contains a .NET project marker."
-  (or (projectile-verify-file-wildcard "?*.csproj")
-      (projectile-verify-file-wildcard "?*.fsproj")))
-
-(defun projectile-go-project-p ()
-  "Check if a project contains Go source files."
-  (or (projectile-verify-file "go.mod")
-      (projectile-verify-file-wildcard "*.go")))
+(defun projectile-eldev-project-p (&optional dir)
+  "Check if a project contains eldev files.
+When DIR is specified it checks DIR's project, otherwise
+it acts on the current project."
+  (or (projectile-verify-file "Eldev" dir)
+      (projectile-verify-file "Eldev-local" dir)))
+
+(defun projectile-cabal-project-p (&optional dir)
+  "Check if a project contains *.cabal files but no stack.yaml file.
+When DIR is specified it checks DIR's project, otherwise
+it acts on the current project."
+  (and (projectile-verify-file-wildcard "?*.cabal" dir)
+       (not (projectile-verify-file "stack.yaml" dir))))
+
+(defun projectile-dotnet-project-p (&optional dir)
+  "Check if a project contains a .NET project marker.
+When DIR is specified it checks DIR's project, otherwise
+it acts on the current project."
+  (or (projectile-verify-file-wildcard "?*.csproj" dir)
+      (projectile-verify-file-wildcard "?*.fsproj" dir)))
+
+(defun projectile-go-project-p (&optional dir)
+  "Check if a project contains Go source files.
+When DIR is specified it checks DIR's project, otherwise
+it acts on the current project."
+  (or (projectile-verify-file "go.mod" dir)
+      (projectile-verify-file-wildcard "*.go" dir)))
 
 (defcustom projectile-go-project-test-function #'projectile-go-project-p
   "Function to determine if project's type is go."
@@ -3378,8 +3393,7 @@ a manual COMMAND-TYPE command is created with
                                   :compile "cask install"
                                   :test-prefix "test-"
                                   :test-suffix "-test")
-(projectile-register-project-type 'emacs-eldev (lambda () (or (projectile-verify-file "Eldev")
-                                                              (projectile-verify-file "Eldev-local")))
+(projectile-register-project-type 'emacs-eldev #'projectile-eldev-project-p
                                   :project-file "Eldev"
                                   :compile "eldev compile"
                                   :test "eldev test"
@@ -3432,20 +3446,23 @@ a manual COMMAND-TYPE command is created with
 Normally you'd set this from .dir-locals.el.")
 (put 'projectile-project-type 'safe-local-variable #'symbolp)
 
-(defun projectile-detect-project-type ()
-  "Detect the type of the current project.
+(defun projectile-detect-project-type (&optional dir)
+  "Detect the type of the project.
+When DIR is specified it detects its project type, otherwise it acts
+on the current project.
+
 Fallsback to a generic project type when the type can't be determined."
   (let ((project-type
          (or (car (cl-find-if
                    (lambda (project-type-record)
                      (let ((project-type (car project-type-record))
                            (marker (plist-get (cdr project-type-record) 'marker-files)))
                        (if (functionp marker)
-                           (and (funcall marker) project-type)
-                         (and (projectile-verify-files marker) project-type))))
+                           (and (funcall marker dir) project-type)
+                         (and (projectile-verify-files marker dir) project-type))))
                    projectile-project-types))
              'generic)))
-    (puthash (projectile-project-root) project-type projectile-project-type-cache)
+    (puthash (projectile-project-root dir) project-type projectile-project-type-cache)
     project-type))
 
 (defun projectile-project-type (&optional dir)
@@ -3454,15 +3471,10 @@ When DIR is specified it checks it, otherwise it acts
 on the current project.
 
 The project type is cached for improved performance."
-  (if projectile-project-type
-      projectile-project-type
-    (let* ((dir (or dir default-directory))
-           (project-root (projectile-project-root dir)))
-      (if project-root
+  (or (and (not dir) projectile-project-type)
+      (if-let ((project-root (projectile-project-root dir)))
           (or (gethash project-root projectile-project-type-cache)
-              (projectile-detect-project-type))
-        ;; if we're not in a project we just return nil
-        nil))))
+              (projectile-detect-project-type dir)))))
 
 ;;;###autoload
 (defun projectile-project-info ()
@@ -3473,18 +3485,24 @@ The project type is cached for improved performance."
            (projectile-project-vcs)
            (projectile-project-type)))
 
-(defun projectile-verify-files (files)
-  "Check whether all FILES exist in the current project."
-  (cl-every #'projectile-verify-file files))
+(defun projectile-verify-files (files &optional dir)
+  "Check whether all FILES exist in the project.
+When DIR is specified it checks DIR's project, otherwise
+it acts on the current project."
+  (cl-every #'(lambda (file) (projectile-verify-file file dir)) files))
 
-(defun projectile-verify-file (file)
-  "Check whether FILE exists in the current project."
-  (file-exists-p (projectile-expand-root file)))
+(defun projectile-verify-file (file &optional dir)
+  "Check whether FILE exists in the current project.
+When DIR is specified it checks DIR's project, otherwise
+it acts on the current project."
+  (file-exists-p (projectile-expand-root file dir)))
 
-(defun projectile-verify-file-wildcard (file)
+(defun projectile-verify-file-wildcard (file &optional dir)
   "Check whether FILE exists in the current project.
+When DIR is specified it checks DIR's project, otherwise
+it acts on the current project.
 Expands wildcards using `file-expand-wildcards' before checking."
-  (file-expand-wildcards (projectile-expand-root file)))
+  (file-expand-wildcards (projectile-expand-root file dir)))
 
 (defun projectile-project-vcs (&optional project-root)
   "Determine the VCS used by the project if any.

test/projectile-test.el

@@ -291,10 +291,26 @@ Just delegates OPERATION and ARGS for all operations except for`shell-command`'.
        :to-throw))))
 
 (describe "projectile-project-type"
+  :var ((dir default-directory))
   (it "detects the type of Projectile's project"
     (expect (projectile-project-type) :to-equal 'emacs-eldev))
   (it "caches the project type"
-    (expect (gethash (projectile-project-root) projectile-project-type-cache) :to-equal 'emacs-eldev)))
+    (expect (gethash (projectile-project-root) projectile-project-type-cache) :to-equal 'emacs-eldev))
+  (it "detects the type of Projectile's project when it is passed as args"
+    (projectile-test-with-sandbox
+      (let ((projectile-project-type-cache (make-hash-table :test 'equal)))
+        (expect (projectile-project-type dir) :to-equal 'emacs-eldev))))
+  (describe "override by projectile-project-type"
+    (it "is respected when no DIR is passed"
+      (let ((projectile-project-type 'python-poetry))
+        (expect projectile-project-type :to-equal 'python-poetry)))
+    (it "has no effect when DIR is passed"
+      (projectile-test-with-sandbox
+        (let ((projectile-project-type 'python-poetry))
+          (expect (projectile-project-type dir) :to-equal 'emacs-eldev))))))
+
+
+
 
 (describe "projectile-ignored-directory-p"
   (it "checks if directory should be ignored"
@@ -815,7 +831,7 @@ Just delegates OPERATION and ARGS for all operations except for`shell-command`'.
         (puthash (projectile-project-root)
                  '("file1.el")
                  projectile-projects-cache)
-        (spy-on 'projectile-project-root :and-call-fake (lambda () (file-truename default-directory)))
+        (spy-on 'projectile-project-root :and-call-fake (lambda (&optional _dir) (file-truename default-directory)))
         (spy-on 'projectile-project-vcs :and-return-value 'none)
         (with-current-buffer (find-file-noselect  "file2.el" t)
           (projectile-cache-current-file)
@@ -1885,13 +1901,13 @@ projectile-process-current-project-buffers-current to have similar behaviour"
          '((foo test-suffix "Test")
            (bar test-prefix "Test"))))
   (it "removes suffix from test file"
-    (cl-letf (((symbol-function 'projectile-project-type) (lambda () 'foo))
+    (cl-letf (((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'foo))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-name-for-test-name "FooTest.cpp")
               :to-equal
               "Foo.cpp")))
   (it "removes prefix from test file"
-    (cl-letf (((symbol-function 'projectile-project-type) (lambda () 'bar))
+    (cl-letf (((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'bar))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-name-for-test-name "TestFoo.cpp")
               :to-equal
@@ -1914,32 +1930,32 @@ projectile-process-current-project-buffers-current to have similar behaviour"
   (it "returns result of projectile--complementary-file when src-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 'projectile-project-type) (lambda (&optional _dir) 'foo))
+              ((symbol-function 'projectile-project-root) (lambda (&optional _dir) "foo"))
               ((symbol-function 'file-relative-name) (lambda (f rel) f))
               ((symbol-function 'file-exists-p) (lambda (file) t))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-file-from-src-dir-fn "foo") :to-equal "/outer/foo/test/dir")))
   (it "returns file relative to project root"
     (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 () "/outer/foo"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'foo))
+              ((symbol-function 'projectile-project-root) (lambda (&optional _dir) "/outer/foo"))
               ((symbol-function 'file-exists-p) (lambda (file) t))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-file-from-src-dir-fn "/outer/foo/bar")
               :to-equal
               "test/dir")))
   (it "returns nil when src-dir property is a not function"
-    (cl-letf (((symbol-function 'projectile-project-type) (lambda () 'bar))
-              ((symbol-function 'projectile-project-root) (lambda () "foo"))
+    (cl-letf (((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'bar))
+              ((symbol-function 'projectile-project-root) (lambda (&optional _dir) "foo"))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-file-from-src-dir-fn "bar") :to-equal nil)))
   (it "returns nil when src-dir function result is not an existing file"
     (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 () "/outer/foo"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'foo))
+              ((symbol-function 'projectile-project-root) (lambda (&optional _dir) "/outer/foo"))
               ((symbol-function 'file-exists-p) #'ignore)
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-file-from-src-dir-fn "bar") :to-equal nil))))
@@ -1951,24 +1967,24 @@ projectile-process-current-project-buffers-current to have similar behaviour"
   (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 'projectile-project-type) (lambda (&optional _dir) 'foo))
+              ((symbol-function 'projectile-project-root) (lambda (&optional _dir) "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"))
+    (cl-letf (((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'foo))
+              ((symbol-function 'projectile-project-root) (lambda (&optional _dir) "/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))
+    (cl-letf (((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'bar))
               (projectile-project-types mock-projectile-project-types)
-              ((symbol-function 'projectile-project-root) (lambda () "foo")))
+              ((symbol-function 'projectile-project-root) (lambda (&optional _dir) "foo")))
       (expect (projectile--test-file-from-test-dir-fn "bar") :to-equal nil))))
 
 (describe "projectile--complementary-file"
@@ -1987,18 +2003,18 @@ projectile-process-current-project-buffers-current to have similar behaviour"
          '((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))
+    (cl-letf (((symbol-function 'projectile-project-root) (lambda (&optional _dir) "foo"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'foo))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-to-test-dir "/foo/src/Foo") :to-equal "/foo/test/")))
   (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))
+    (cl-letf (((symbol-function 'projectile-project-root) (lambda (&optional _dir) "bar"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'bar))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-to-test-dir "/bar/src/bar") :to-be nil)))
   (it "error when src-dir not a substring of impl file"
-    (cl-letf (((symbol-function 'projectile-project-root) (lambda () "foo"))
-              ((symbol-function 'projectile-project-type) (lambda () 'foo))
+    (cl-letf (((symbol-function 'projectile-project-root) (lambda (&optional _dir) "foo"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'foo))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--impl-to-test-dir "/bar/other/bar") :to-throw))))
 
@@ -2007,18 +2023,18 @@ projectile-process-current-project-buffers-current to have similar behaviour"
          '((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))
+    (cl-letf (((symbol-function 'projectile-project-root) (lambda (&optional _dir) "foo"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) '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))
+    (cl-letf (((symbol-function 'projectile-project-root) (lambda (&optional _dir) "bar"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'bar))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--test-to-impl-dir "/bar/test/bar") :to-be nil)))
   (it "error when test-dir not a substring of test file"
-    (cl-letf (((symbol-function 'projectile-project-root) (lambda () "foo"))
-              ((symbol-function 'projectile-project-type) (lambda () 'foo))
+    (cl-letf (((symbol-function 'projectile-project-root) (lambda (&optional _dir) "foo"))
+              ((symbol-function 'projectile-project-type) (lambda (&optional _dir) 'foo))
               (projectile-project-types mock-projectile-project-types))
       (expect (projectile--test-to-impl-dir "/bar/other/bar") :to-throw))))