From 7811b1e2280f83c26daf6d9922b409222b612a2d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 28 Feb 2025 14:45:39 +0200 Subject: [PATCH] Fix 'internal--c-header-file-path' * lisp/subr.el (internal--c-header-file-path): Fix for MS-Windows: don't prepend the (usually non-existent) "/usr/include", and run each directory through 'expand-file-name' to remove the many ".." elements and mirror any backslashes. Invoke "clang" if "gcc" is not available or is actually clang. * test/lisp/subr-tests.el (subr-tests-internal--c-header-file-path): Fix for MS-Windows: test the path by looking for stdio.h, and expand all directory names to compare to expected results. (cherry picked from commit a04e8812ee0dfb7f2984d0b57b380cf15c73567c) --- lisp/subr.el | 31 +++++++++++++++++++++---------- test/lisp/subr-tests.el | 19 ++++++++++++------- 2 files changed, 33 insertions(+), 17 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 8f524e11298..be2e292cdc8 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7157,14 +7157,20 @@ and return the value found in PLACE instead." (defun internal--c-header-file-path () "Return search path for C header files (a list of strings)." (delete-dups - (let ((base '("/usr/include" "/usr/local/include"))) - (cond ((or (internal--gcc-is-clang-p) - (and (executable-find "clang") - (not (executable-find "gcc")))) - ;; This is either macOS, or a system with clang only. + ;; We treat MS-Windows/MS-DOS specially, since there's no + ;; widely-accepted canonical directory for C include files. + (let ((base (if (not (memq system-type '(windows-nt ms-dos))) + '("/usr/include" "/usr/local/include"))) + (call-clang-p (or (internal--gcc-is-clang-p) + (and (executable-find "clang") + (not (executable-find "gcc")))))) + (cond ((or call-clang-p + (memq system-type '(windows-nt ms-dos))) + ;; This is either macOS, or MS-Windows/MS-DOS, or a system + ;; with clang only. (with-temp-buffer (ignore-errors - (call-process (if (internal--gcc-is-clang-p) "gcc" "clang") + (call-process (if call-clang-p "clang" "gcc") nil t nil "-v" "-E" "-")) (goto-char (point-min)) @@ -7178,10 +7184,15 @@ and return the value found in PLACE instead." (pos-bol))) (while (search-forward "(framework directory)" nil t) (delete-line)) - (append base - (reverse - (split-string (buffer-substring-no-properties - (point-min) (point-max))))))) + ;; "gcc -v" reports file names with many "..", so we + ;; normalize it. + (or (mapcar #'expand-file-name + (append base + (split-string (buffer-substring-no-properties + (point-min) (point-max))))) + ;; Fallback for whedn the compiler is not available. + (list (expand-file-name "/usr/include") + (expand-file-name "/usr/local/include"))))) ;; Prefer GCC. ((let ((arch (with-temp-buffer (when (eq 0 (ignore-errors diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index b21f90226c6..c2f64867d90 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1465,14 +1465,17 @@ final or penultimate step during initialization.")) (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 (locate-file "stdio.h" (internal--c-header-file-path))) + (or (memq system-type '(windows-nt ms-dos)) + (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 (member (expand-file-name "/usr/include") + (internal--c-header-file-path))) (should (equal (internal--c-header-file-path) (delete-dups (internal--c-header-file-path)))))) @@ -1482,13 +1485,16 @@ final or penultimate step during initialization.")) (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)))) + (should (member (expand-file-name "/usr/include") + (internal--c-header-file-path)))) ;; Handle single values of "gcc -print-multiarch". - (cl-letf (((symbol-function 'call-process) + (cl-letf ((system-type 'foo) + ((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))))) + (should (member (expand-file-name "/usr/include/x86_64-linux-gnu") + (internal--c-header-file-path))))) (ert-deftest subr-tests-internal--c-header-file-path/clang-mocked () ;; Handle clang 15.0.0 output on macOS 15.2. @@ -1519,8 +1525,7 @@ End of search list. # 1 \"\" 2 # 1 \"\" 2") 0))) - (should (member "/usr/include" (internal--c-header-file-path))) - (should (member "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include" + (should (member (expand-file-name "/Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/lib/clang/15.0.0/include") (internal--c-header-file-path))))) (provide 'subr-tests) -- 2.39.5