Commit | Line | Data |
---|---|---|
4feec2f5 CY |
1 | ;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser |
2 | ||
3 | ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; GCC stores things in special places. These functions will query | |
25 | ;; GCC, and set up the preprocessor and include paths. | |
26 | ||
27 | (require 'semantic/dep) | |
28 | ||
1fe1547a CY |
29 | (defvar semantic-lex-c-preprocessor-symbol-file) |
30 | (defvar semantic-lex-c-preprocessor-symbol-map) | |
4feec2f5 CY |
31 | (declare-function semantic-c-reset-preprocessor-symbol-map |
32 | "semantic/bovine/gcc") | |
33 | ||
34 | ;;; Code: | |
35 | ||
36 | (defun semantic-gcc-query (gcc-cmd &rest gcc-options) | |
37 | "Return program output to both standard output and standard error. | |
38 | GCC-CMD is the program to execute and GCC-OPTIONS are the options | |
39 | to give to the program." | |
40 | ;; $ gcc -v | |
41 | ;; | |
42 | (let ((buff (get-buffer-create " *gcc-query*")) | |
43 | (old-lc-messages (getenv "LC_ALL"))) | |
44 | (save-excursion | |
45 | (set-buffer buff) | |
46 | (erase-buffer) | |
47 | (setenv "LC_ALL" "C") | |
48 | (condition-case nil | |
49 | (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options) | |
50 | (error ;; Some bogus directory for the first time perhaps? | |
51 | (let ((default-directory (expand-file-name "~/"))) | |
52 | (condition-case nil | |
53 | (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options) | |
54 | (error ;; gcc doesn't exist??? | |
55 | nil))))) | |
56 | (setenv "LC_ALL" old-lc-messages) | |
57 | (prog1 | |
58 | (buffer-string) | |
59 | (kill-buffer buff) | |
60 | ) | |
61 | ))) | |
62 | ||
63 | ;;(semantic-gcc-get-include-paths "c") | |
64 | ;;(semantic-gcc-get-include-paths "c++") | |
65 | (defun semantic-gcc-get-include-paths (lang) | |
66 | "Return include paths as gcc use them for language LANG." | |
67 | (let* ((gcc-cmd (cond | |
68 | ((string= lang "c") "gcc") | |
69 | ((string= lang "c++") "c++") | |
70 | (t (if (stringp lang) | |
71 | (error "Unknown lang: %s" lang) | |
72 | (error "LANG=%S, should be a string" lang))))) | |
73 | (gcc-output (semantic-gcc-query gcc-cmd "-v" "-E" "-x" lang null-device)) | |
74 | (lines (split-string gcc-output "\n")) | |
75 | (include-marks 0) | |
76 | (inc-mark "#include ") | |
77 | (inc-mark-len (length "#include ")) | |
78 | inc-path) | |
79 | ;;(message "gcc-output=%s" gcc-output) | |
80 | (dolist (line lines) | |
81 | (when (> (length line) 1) | |
82 | (if (= 0 include-marks) | |
83 | (when (and (> (length line) inc-mark-len) | |
84 | (string= inc-mark (substring line 0 inc-mark-len))) | |
85 | (setq include-marks (1+ include-marks))) | |
86 | (let ((chars (append line nil))) | |
87 | (when (= 32 (nth 0 chars)) | |
88 | (let ((path (substring line 1))) | |
89 | (when (file-accessible-directory-p path) | |
90 | (when (if (memq system-type '(windows-nt)) | |
91 | (/= ?/ (nth 1 chars)) | |
92 | (= ?/ (nth 1 chars))) | |
93 | (add-to-list 'inc-path | |
94 | (expand-file-name (substring line 1)) | |
95 | t))))))))) | |
96 | inc-path)) | |
97 | ||
98 | ||
99 | (defun semantic-cpp-defs (str) | |
100 | "Convert CPP output STR into a list of cons cells with defines for C++." | |
101 | (let ((lines (split-string str "\n")) | |
102 | (lst nil)) | |
103 | (dolist (L lines) | |
104 | (let ((dat (split-string L))) | |
105 | (when (= (length dat) 3) | |
106 | (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat)))))) | |
107 | lst)) | |
108 | ||
109 | (defun semantic-gcc-fields (str) | |
110 | "Convert GCC output STR into an alist of fields." | |
111 | (let ((fields nil) | |
112 | (lines (split-string str "\n")) | |
113 | ) | |
114 | (dolist (L lines) | |
115 | ;; For any line, what do we do with it? | |
116 | (cond ((or (string-match "Configured with\\(:\\)" L) | |
117 | (string-match "\\(:\\)\\s-*[^ ]*configure " L)) | |
118 | (let* ((parts (substring L (match-end 1))) | |
119 | (opts (split-string parts " " t)) | |
120 | ) | |
121 | (dolist (O (cdr opts)) | |
122 | (let* ((data (split-string O "=")) | |
123 | (sym (intern (car data))) | |
124 | (val (car (cdr data)))) | |
125 | (push (cons sym val) fields) | |
126 | )) | |
127 | )) | |
128 | ((string-match "gcc[ -][vV]ersion" L) | |
129 | (let* ((vline (substring L (match-end 0))) | |
130 | (parts (split-string vline " "))) | |
131 | (push (cons 'version (nth 1 parts)) fields))) | |
132 | ((string-match "Target: " L) | |
133 | (let ((parts (split-string L " "))) | |
134 | (push (cons 'target (nth 1 parts)) fields))) | |
135 | )) | |
136 | fields)) | |
137 | ||
138 | (defvar semantic-gcc-setup-data nil | |
139 | "The GCC setup data. | |
140 | This is setup by `semantic-gcc-setup'. | |
141 | This is an alist, and should include keys of: | |
142 | 'version - The version of gcc | |
143 | '--host - The host symbol. (Used in include directories) | |
144 | '--prefix - Where GCC was installed. | |
145 | It should also include other symbols GCC was compiled with.") | |
146 | ||
1fe1547a | 147 | ;;;###autoload |
4feec2f5 CY |
148 | (defun semantic-gcc-setup () |
149 | "Setup Semantic C/C++ parsing based on GCC output." | |
150 | (interactive) | |
151 | (let* ((fields (or semantic-gcc-setup-data | |
152 | (semantic-gcc-fields (semantic-gcc-query "gcc" "-v")))) | |
153 | (defines (semantic-cpp-defs (semantic-gcc-query "cpp" "-E" "-dM" "-x" "c++" null-device))) | |
154 | (ver (cdr (assoc 'version fields))) | |
155 | (host (or (cdr (assoc 'target fields)) | |
156 | (cdr (assoc '--target fields)) | |
157 | (cdr (assoc '--host fields)))) | |
158 | (prefix (cdr (assoc '--prefix fields))) | |
159 | ;; gcc output supplied paths | |
160 | (c-include-path (semantic-gcc-get-include-paths "c")) | |
161 | (c++-include-path (semantic-gcc-get-include-paths "c++"))) | |
162 | ;; Remember so we don't have to call GCC twice. | |
163 | (setq semantic-gcc-setup-data fields) | |
164 | (unless c-include-path | |
165 | ;; Fallback to guesses | |
166 | (let* ( ;; gcc include dirs | |
167 | (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable)) | |
168 | (gcc-root (expand-file-name ".." (file-name-directory gcc-exe))) | |
169 | (gcc-include (expand-file-name "include" gcc-root)) | |
170 | (gcc-include-c++ (expand-file-name "c++" gcc-include)) | |
171 | (gcc-include-c++-ver (expand-file-name ver gcc-include-c++)) | |
172 | (gcc-include-c++-ver-host (expand-file-name host gcc-include-c++-ver))) | |
173 | (setq c-include-path | |
174 | (remove-if-not 'file-accessible-directory-p | |
175 | (list "/usr/include" gcc-include))) | |
176 | (setq c++-include-path | |
177 | (remove-if-not 'file-accessible-directory-p | |
178 | (list "/usr/include" | |
179 | gcc-include | |
180 | gcc-include-c++ | |
181 | gcc-include-c++-ver | |
182 | gcc-include-c++-ver-host))))) | |
183 | ||
184 | ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure. | |
185 | ;; If this option is specified, try it both with and without prefix, and with and without host | |
186 | ;; (if (assoc '--with-gxx-include-dir fields) | |
187 | ;; (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields)))) | |
188 | ;; (nconc try-paths (list gxx-include-dir | |
189 | ;; (concat prefix gxx-include-dir) | |
190 | ;; (concat gxx-include-dir "/" host) | |
191 | ;; (concat prefix gxx-include-dir "/" host))))) | |
192 | ||
193 | ;; Now setup include paths etc | |
194 | (dolist (D (semantic-gcc-get-include-paths "c")) | |
195 | (semantic-add-system-include D 'c-mode)) | |
196 | (dolist (D (semantic-gcc-get-include-paths "c++")) | |
197 | (semantic-add-system-include D 'c++-mode) | |
198 | (let ((cppconfig (concat D "/bits/c++config.h"))) | |
199 | ;; Presumably there will be only one of these files in the try-paths list... | |
200 | (when (file-readable-p cppconfig) | |
201 | ;; Add it to the symbol file | |
202 | (if (boundp 'semantic-lex-c-preprocessor-symbol-file) | |
203 | ;; Add to the core macro header list | |
204 | (add-to-list 'semantic-lex-c-preprocessor-symbol-file cppconfig) | |
205 | ;; Setup the core macro header | |
206 | (setq semantic-lex-c-preprocessor-symbol-file (list cppconfig))) | |
207 | ))) | |
208 | (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map)) | |
209 | (setq semantic-lex-c-preprocessor-symbol-map nil)) | |
210 | (dolist (D defines) | |
211 | (add-to-list 'semantic-lex-c-preprocessor-symbol-map D)) | |
212 | (when (featurep 'semantic/bovine/c) | |
213 | (semantic-c-reset-preprocessor-symbol-map)) | |
214 | nil)) | |
215 | ||
216 | ;;; TESTING | |
217 | ;; | |
218 | ;; Example output of "gcc -v" | |
219 | (defvar semantic-gcc-test-strings | |
220 | '(;; My old box: | |
221 | "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs | |
222 | Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux | |
223 | Thread model: posix | |
224 | gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)" | |
225 | ;; Alex Ott: | |
226 | "Using built-in specs. | |
227 | Target: i486-linux-gnu | |
228 | Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.1-9ubuntu1' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu | |
229 | Thread model: posix | |
230 | gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)" | |
231 | ;; My debian box: | |
232 | "Using built-in specs. | |
233 | Target: x86_64-unknown-linux-gnu | |
234 | Configured with: ../../../sources/gcc/configure --prefix=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3 --with-gmp=/usr/local/gcc/gmp --with-mpfr=/usr/local/gcc/mpfr --enable-languages=c,c++,fortran --with-as=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/as --with-ld=/usr/local/glibc-2.3.6/x86_64/apps/gcc-4.2.3/bin/ld --disable-multilib | |
235 | Thread model: posix | |
236 | gcc version 4.2.3" | |
237 | ;; My mac: | |
238 | "Using built-in specs. | |
239 | Target: i686-apple-darwin8 | |
240 | Configured with: /private/var/tmp/gcc/gcc-5341.obj~1/src/configure --disable-checking -enable-werror --prefix=/usr --mandir=/share/man --enable-languages=c,objc,c++,obj-c++ --program-transform-name=/^[cg][^.-]*$/s/$/-4.0/ --with-gxx-include-dir=/include/c++/4.0.0 --with-slibdir=/usr/lib --build=powerpc-apple-darwin8 --with-arch=pentium-m --with-tune=prescott --program-prefix= --host=i686-apple-darwin8 --target=i686-apple-darwin8 | |
241 | Thread model: posix | |
242 | gcc version 4.0.1 (Apple Computer, Inc. build 5341)" | |
243 | ;; Ubuntu Intrepid | |
244 | "Using built-in specs. | |
245 | Target: x86_64-linux-gnu | |
246 | Configured with: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu | |
247 | Thread model: posix | |
248 | gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" | |
249 | ;; Red Hat EL4 | |
250 | "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs | |
251 | Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-java-awt=gtk --host=x86_64-redhat-linux | |
252 | Thread model: posix | |
253 | gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)" | |
254 | ;; Red Hat EL5 | |
255 | "Using built-in specs. | |
256 | Target: x86_64-redhat-linux | |
257 | Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-libgcj-multifile --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --enable-plugin --with-java-home=/usr/lib/jvm/java-1.4.2-gcj-1.4.2.0/jre --with-cpu=generic --host=x86_64-redhat-linux | |
258 | Thread model: posix | |
259 | gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)" | |
260 | ;; David Engster's german gcc on ubuntu 4.3 | |
261 | "Es werden eingebaute Spezifikationen verwendet. | |
262 | Ziel: i486-linux-gnu | |
263 | Konfiguriert mit: ../src/configure -v --with-pkgversion='Ubuntu 4.3.2-1ubuntu12' --with-bugurl=file:///usr/share/doc/gcc-4.3/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --enable-shared --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --enable-nls --with-gxx-include-dir=/usr/include/c++/4.3 --program-suffix=-4.3 --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-mpfr --enable-targets=all --enable-checking=release --build=i486-linux-gnu --host=i486-linux-gnu --target=i486-linux-gnu | |
264 | Thread-Modell: posix | |
265 | gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)" | |
266 | ;; Damien Deville bsd | |
267 | "Using built-in specs. | |
268 | Target: i386-undermydesk-freebsd | |
269 | Configured with: FreeBSD/i386 system compiler | |
270 | Thread model: posix | |
271 | gcc version 4.2.1 20070719 [FreeBSD]" | |
272 | ) | |
273 | "A bunch of sample gcc -v outputs from different machines.") | |
274 | ||
275 | (defvar semantic-gcc-test-strings-fail | |
276 | '(;; A really old solaris box I found | |
277 | "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs | |
278 | gcc version 2.95.2 19991024 (release)" | |
279 | ) | |
280 | "A bunch of sample gcc -v outputs that fail to provide the info we want.") | |
281 | ||
282 | (defun semantic-gcc-test-output-parser () | |
283 | "Test the output parser against some collected strings." | |
284 | (interactive) | |
285 | (let ((fail nil)) | |
286 | (dolist (S semantic-gcc-test-strings) | |
287 | (let* ((fields (semantic-gcc-fields S)) | |
288 | (v (cdr (assoc 'version fields))) | |
289 | (h (or (cdr (assoc 'target fields)) | |
290 | (cdr (assoc '--target fields)) | |
291 | (cdr (assoc '--host fields)))) | |
292 | (p (cdr (assoc '--prefix fields))) | |
293 | ) | |
294 | ;; No longer test for prefixes. | |
295 | (when (not (and v h)) | |
296 | (let ((strs (split-string S "\n"))) | |
297 | (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p)) | |
298 | (setq fail t)) | |
299 | )) | |
300 | (dolist (S semantic-gcc-test-strings-fail) | |
301 | (let* ((fields (semantic-gcc-fields S)) | |
302 | (v (cdr (assoc 'version fields))) | |
303 | (h (or (cdr (assoc '--host fields)) | |
304 | (cdr (assoc 'target fields)))) | |
305 | (p (cdr (assoc '--prefix fields))) | |
306 | ) | |
307 | (when (and v h p) | |
308 | (message "Negative test failed on %S" S) | |
309 | (setq fail t)) | |
310 | )) | |
311 | (if (not fail) (message "Tests passed.")) | |
312 | )) | |
313 | ||
314 | (defun semantic-gcc-test-output-parser-this-machine () | |
315 | "Test the output parser against the machine currently running Emacs." | |
316 | (interactive) | |
317 | (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v")))) | |
318 | (semantic-gcc-test-output-parser)) | |
319 | ) | |
320 | ||
321 | (provide 'semantic/bovine/gcc) | |
1fe1547a CY |
322 | |
323 | ;; Local variables: | |
324 | ;; generated-autoload-file: "../loaddefs.el" | |
325 | ;; generated-autoload-feature: semantic/loaddefs | |
326 | ;; generated-autoload-load-name: "semantic/bovine/gcc" | |
327 | ;; End: | |
328 | ||
4feec2f5 | 329 | ;;; semantic/bovine/gcc.el ends here |