diff --git a/lisp/ffap.el b/lisp/ffap.el index c2b181b55f3..890a227fca9 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -831,22 +831,7 @@ to extract substrings.") (and (not (string-match "\\.el\\'" name)) (ffap-locate-file name '(".el") load-path))) -;; FIXME this duplicates the logic of Man-header-file-path. -;; There should be a single central variable or function for this. -;; See also (bug#10702): -;; cc-search-directories, semantic-c-dependency-system-include-path, -;; semantic-gcc-setup -(defvar ffap-c-path - (let ((arch (with-temp-buffer - (when (eq 0 (ignore-errors - (call-process "gcc" nil '(t nil) nil - "-print-multiarch"))) - (goto-char (point-min)) - (buffer-substring (point) (line-end-position))))) - (base '("/usr/include" "/usr/local/include"))) - (if (zerop (length arch)) - base - (append base (list (expand-file-name arch "/usr/include"))))) +(defvar ffap-c-path (internal--c-header-file-path) "List of directories to search for include files.") (defun ffap-c-mode (name) diff --git a/lisp/man.el b/lisp/man.el index 29c3dec501c..b030e57aaf8 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -230,18 +230,7 @@ the associated section number." :type '(repeat (cons (string :tag "Bogus Section") (string :tag "Real Section")))) -;; FIXME see comments at ffap-c-path. -(defcustom Man-header-file-path - (let ((arch (with-temp-buffer - (when (eq 0 (ignore-errors - (call-process "gcc" nil '(t nil) nil - "-print-multiarch"))) - (goto-char (point-min)) - (buffer-substring (point) (line-end-position))))) - (base '("/usr/include" "/usr/local/include"))) - (if (zerop (length arch)) - base - (append base (list (expand-file-name arch "/usr/include"))))) +(defcustom Man-header-file-path (internal--c-header-file-path) "C Header file search path used in Man." :version "24.1" ; add multiarch :type '(repeat string)) diff --git a/lisp/subr.el b/lisp/subr.el index 5646ab268a4..9044a92c5f5 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7556,4 +7556,22 @@ and return the value found in PLACE instead." ,(funcall setter val) ,val))))) +(defun internal--c-header-file-path () + "Return search path for C header files (a list of strings)." + ;; FIXME: It's not clear that this is a good place to put this, or + ;; even that this should necessarily be internal. + ;; See also (Bug#10702): + ;; cc-search-directories, semantic-c-dependency-system-include-path, + ;; semantic-gcc-setup + (let ((arch (with-temp-buffer + (when (eq 0 (ignore-errors + (call-process "gcc" nil '(t nil) nil + "-print-multiarch"))) + (goto-char (point-min)) + (buffer-substring (point) (line-end-position))))) + (base '("/usr/include" "/usr/local/include"))) + (if (zerop (length arch)) + base + (append base (list (expand-file-name arch "/usr/include")))))) + ;;; subr.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index e6964c42ca8..2cb0b616074 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -27,6 +27,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (eval-when-compile (require 'cl-lib)) (ert-deftest let-when-compile () @@ -1382,5 +1383,32 @@ final or penultimate step during initialization.")) (props-out (object-intervals out))) (should (equal props-out props-in)))))))) +(ert-deftest subr-tests-internal--c-header-file-path () + (should (seq-every-p #'stringp (internal--c-header-file-path))) + (should (member "/usr/include" (internal--c-header-file-path))) + (should (equal (internal--c-header-file-path) + (delete-dups (internal--c-header-file-path)))) + ;; Return a meaningful result even if calling some compiler fails. + (cl-letf (((symbol-function 'call-process) + (lambda (_program &optional _infile _destination _display &rest _args) 1))) + (should (seq-every-p #'stringp (internal--c-header-file-path))) + (should (member "/usr/include" (internal--c-header-file-path))) + (should (equal (internal--c-header-file-path) + (delete-dups (internal--c-header-file-path)))))) + +(ert-deftest subr-tests-internal--c-header-file-path/gcc-mocked () + ;; Handle empty values of "gcc -print-multiarch". + (cl-letf (((symbol-function 'call-process) + (lambda (_program &optional _infile _destination _display &rest args) + (when (equal (car args) "-print-multiarch") + (insert "\n") 0)))) + (should (member "/usr/include" (internal--c-header-file-path)))) + ;; Handle single values of "gcc -print-multiarch". + (cl-letf (((symbol-function 'call-process) + (lambda (_program &optional _infile _destination _display &rest args) + (when (equal (car args) "-print-multiarch") + (insert "x86_64-linux-gnu\n") 0)))) + (should (member "/usr/include/x86_64-linux-gnu" (internal--c-header-file-path))))) + (provide 'subr-tests) ;;; subr-tests.el ends here