code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/bovine/gcc.el

   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
  29 (declare-function semantic-c-reset-preprocessor-symbol-map
  30                   "semantic/bovine/gcc")
  31
  32 ;;; Code:
  33
  34 (defun semantic-gcc-query (gcc-cmd &rest gcc-options)
  35   "Return program output to both standard output and standard error.
  36 GCC-CMD is the program to execute and GCC-OPTIONS are the options
  37 to give to the program."
  38   ;; $ gcc -v
  39   ;;
  40   (let ((buff (get-buffer-create " *gcc-query*"))
  41         (old-lc-messages (getenv "LC_ALL")))
  42     (save-excursion
  43       (set-buffer buff)
  44       (erase-buffer)
  45       (setenv "LC_ALL" "C")
  46       (condition-case nil
  47           (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options)
  48         (error ;; Some bogus directory for the first time perhaps?
  49          (let ((default-directory (expand-file-name "~/")))
  50            (condition-case nil
  51                (apply 'call-process gcc-cmd nil (cons buff t) nil gcc-options)
  52              (error ;; gcc doesn't exist???
  53               nil)))))
  54       (setenv "LC_ALL" old-lc-messages)
  55       (prog1
  56           (buffer-string)
  57         (kill-buffer buff)
  58         )
  59       )))
  60
  61 ;;(semantic-gcc-get-include-paths "c")
  62 ;;(semantic-gcc-get-include-paths "c++")
  63 (defun semantic-gcc-get-include-paths (lang)
  64   "Return include paths as gcc use them for language LANG."
  65   (let* ((gcc-cmd (cond
  66                    ((string= lang "c") "gcc")
  67                    ((string= lang "c++") "c++")
  68                    (t (if (stringp lang)
  69                           (error "Unknown lang: %s" lang)
  70                         (error "LANG=%S, should be a string" lang)))))
  71          (gcc-output (semantic-gcc-query gcc-cmd "-v" "-E" "-x" lang null-device))
  72          (lines (split-string gcc-output "\n"))
  73          (include-marks 0)
  74          (inc-mark "#include ")
  75          (inc-mark-len (length "#include "))
  76          inc-path)
  77     ;;(message "gcc-output=%s" gcc-output)
  78     (dolist (line lines)
  79       (when (> (length line) 1)
  80         (if (= 0 include-marks)
  81             (when (and (> (length line) inc-mark-len)
  82                        (string= inc-mark (substring line 0 inc-mark-len)))
  83               (setq include-marks (1+ include-marks)))
  84           (let ((chars (append line nil)))
  85             (when (= 32 (nth 0 chars))
  86               (let ((path (substring line 1)))
  87                 (when (file-accessible-directory-p path)
  88                   (when (if (memq system-type '(windows-nt))
  89                             (/= ?/ (nth 1 chars))
  90                           (= ?/ (nth 1 chars)))
  91                     (add-to-list 'inc-path
  92                                  (expand-file-name (substring line 1))
  93                                  t)))))))))
  94     inc-path))
  95
  96
  97 (defun semantic-cpp-defs (str)
  98   "Convert CPP output STR into a list of cons cells with defines for C++."
  99   (let ((lines (split-string str "\n"))
 100         (lst nil))
 101     (dolist (L lines)
 102       (let ((dat (split-string L)))
 103         (when (= (length dat) 3)
 104           (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat))))))
 105     lst))
 106
 107 (defun semantic-gcc-fields (str)
 108   "Convert GCC output STR into an alist of fields."
 109   (let ((fields nil)
 110         (lines (split-string str "\n"))
 111         )
 112     (dolist (L lines)
 113       ;; For any line, what do we do with it?
 114       (cond ((or (string-match "Configured with\\(:\\)" L)
 115                  (string-match "\\(:\\)\\s-*[^ ]*configure " L))
 116              (let* ((parts (substring L (match-end 1)))
 117                     (opts (split-string parts " " t))
 118                     )
 119                (dolist (O (cdr opts))
 120                  (let* ((data (split-string O "="))
 121                         (sym (intern (car data)))
 122                         (val (car (cdr data))))
 123                    (push (cons sym val) fields)
 124                    ))
 125                ))
 126             ((string-match "gcc[ -][vV]ersion" L)
 127              (let* ((vline (substring L (match-end 0)))
 128                     (parts (split-string vline " ")))
 129                (push (cons 'version (nth 1 parts)) fields)))
 130             ((string-match "Target: " L)
 131              (let ((parts (split-string L " ")))
 132                (push (cons 'target (nth 1 parts)) fields)))
 133             ))
 134     fields))
 135
 136 (defvar semantic-gcc-setup-data nil
 137   "The GCC setup data.
 138 This is setup by `semantic-gcc-setup'.
 139 This is an alist, and should include keys of:
 140   'version - The version of gcc
 141   '--host  - The host symbol.  (Used in include directories)
 142   '--prefix - Where GCC was installed.
 143 It should also include other symbols GCC was compiled with.")
 144
 145 (defun semantic-gcc-setup ()
 146   "Setup Semantic C/C++ parsing based on GCC output."
 147   (interactive)
 148   (let* ((fields (or semantic-gcc-setup-data
 149                      (semantic-gcc-fields (semantic-gcc-query "gcc" "-v"))))
 150          (defines (semantic-cpp-defs (semantic-gcc-query "cpp" "-E" "-dM" "-x" "c++" null-device)))
 151          (ver (cdr (assoc 'version fields)))
 152          (host (or (cdr (assoc 'target fields))
 153                    (cdr (assoc '--target fields))
 154                    (cdr (assoc '--host fields))))
 155          (prefix (cdr (assoc '--prefix fields)))
 156          ;; gcc output supplied paths
 157          (c-include-path (semantic-gcc-get-include-paths "c"))
 158          (c++-include-path (semantic-gcc-get-include-paths "c++")))
 159     ;; Remember so we don't have to call GCC twice.
 160     (setq semantic-gcc-setup-data fields)
 161     (unless c-include-path
 162       ;; Fallback to guesses
 163       (let* ( ;; gcc include dirs
 164              (gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
 165              (gcc-root (expand-file-name ".." (file-name-directory gcc-exe)))
 166              (gcc-include (expand-file-name "include" gcc-root))
 167              (gcc-include-c++ (expand-file-name "c++" gcc-include))
 168              (gcc-include-c++-ver (expand-file-name ver gcc-include-c++))
 169              (gcc-include-c++-ver-host (expand-file-name host gcc-include-c++-ver)))
 170         (setq c-include-path
 171               (remove-if-not 'file-accessible-directory-p
 172                              (list "/usr/include" gcc-include)))
 173         (setq c++-include-path
 174               (remove-if-not 'file-accessible-directory-p
 175                              (list "/usr/include"
 176                                    gcc-include
 177                                    gcc-include-c++
 178                                    gcc-include-c++-ver
 179                                    gcc-include-c++-ver-host)))))
 180
 181     ;;; Fix-me: I think this part might have been a misunderstanding, but I am not sure.
 182     ;; If this option is specified, try it both with and without prefix, and with and without host
 183     ;; (if (assoc '--with-gxx-include-dir fields)
 184     ;;     (let ((gxx-include-dir (cdr (assoc '--with-gxx-include-dir fields))))
 185     ;;       (nconc try-paths (list gxx-include-dir
 186     ;;                              (concat prefix gxx-include-dir)
 187     ;;                              (concat gxx-include-dir "/" host)
 188     ;;                              (concat prefix gxx-include-dir "/" host)))))
 189
 190     ;; Now setup include paths etc
 191     (dolist (D (semantic-gcc-get-include-paths "c"))
 192       (semantic-add-system-include D 'c-mode))
 193     (dolist (D (semantic-gcc-get-include-paths "c++"))
 194       (semantic-add-system-include D 'c++-mode)
 195       (let ((cppconfig (concat D "/bits/c++config.h")))
 196         ;; Presumably there will be only one of these files in the try-paths list...
 197         (when (file-readable-p cppconfig)
 198           ;; Add it to the symbol file
 199           (if (boundp 'semantic-lex-c-preprocessor-symbol-file)
 200               ;; Add to the core macro header list
 201               (add-to-list 'semantic-lex-c-preprocessor-symbol-file cppconfig)
 202             ;; Setup the core macro header
 203             (setq semantic-lex-c-preprocessor-symbol-file (list cppconfig)))
 204           )))
 205     (if (not (boundp 'semantic-lex-c-preprocessor-symbol-map))
 206         (setq semantic-lex-c-preprocessor-symbol-map nil))
 207     (dolist (D defines)
 208       (add-to-list 'semantic-lex-c-preprocessor-symbol-map D))
 209     (when (featurep 'semantic/bovine/c)
 210       (semantic-c-reset-preprocessor-symbol-map))
 211     nil))
 212
 213 ;;; TESTING
 214 ;;
 215 ;; Example output of "gcc -v"
 216 (defvar semantic-gcc-test-strings
 217   '(;; My old box:
 218     "Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/specs
 219 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
 220 Thread model: posix
 221 gcc version 3.2.2 20030222 (Red Hat Linux 3.2.2-5)"
 222     ;; Alex Ott:
 223     "Using built-in specs.
 224 Target: i486-linux-gnu
 225 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
 226 Thread model: posix
 227 gcc version 4.3.1 (Ubuntu 4.3.1-9ubuntu1)"
 228     ;; My debian box:
 229     "Using built-in specs.
 230 Target: x86_64-unknown-linux-gnu
 231 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
 232 Thread model: posix
 233 gcc version 4.2.3"
 234     ;; My mac:
 235     "Using built-in specs.
 236 Target: i686-apple-darwin8
 237 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
 238 Thread model: posix
 239 gcc version 4.0.1 (Apple Computer, Inc. build 5341)"
 240     ;; Ubuntu Intrepid
 241     "Using built-in specs.
 242 Target: x86_64-linux-gnu
 243 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
 244 Thread model: posix
 245 gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
 246     ;; Red Hat EL4
 247     "Reading specs from /usr/lib/gcc/x86_64-redhat-linux/3.4.6/specs
 248 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
 249 Thread model: posix
 250 gcc version 3.4.6 20060404 (Red Hat 3.4.6-10)"
 251     ;; Red Hat EL5
 252     "Using built-in specs.
 253 Target: x86_64-redhat-linux
 254 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
 255 Thread model: posix
 256 gcc version 4.1.2 20080704 (Red Hat 4.1.2-44)"
 257     ;; David Engster's german gcc on ubuntu 4.3
 258     "Es werden eingebaute Spezifikationen verwendet.
 259 Ziel: i486-linux-gnu
 260 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
 261 Thread-Modell: posix
 262 gcc-Version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)"
 263     ;; Damien Deville bsd
 264     "Using built-in specs.
 265 Target: i386-undermydesk-freebsd
 266 Configured with: FreeBSD/i386 system compiler
 267 Thread model: posix
 268 gcc version 4.2.1 20070719  [FreeBSD]"
 269     )
 270   "A bunch of sample gcc -v outputs from different machines.")
 271
 272 (defvar semantic-gcc-test-strings-fail
 273   '(;; A really old solaris box I found
 274     "Reading specs from /usr/local/gcc-2.95.2/lib/gcc-lib/sparc-sun-solaris2.6/2.95.2/specs
 275 gcc version 2.95.2 19991024 (release)"
 276     )
 277   "A bunch of sample gcc -v outputs that fail to provide the info we want.")
 278
 279 (defun semantic-gcc-test-output-parser ()
 280   "Test the output parser against some collected strings."
 281   (interactive)
 282   (let ((fail nil))
 283     (dolist (S semantic-gcc-test-strings)
 284       (let* ((fields (semantic-gcc-fields S))
 285              (v (cdr (assoc 'version fields)))
 286              (h (or (cdr (assoc 'target fields))
 287                     (cdr (assoc '--target fields))
 288                     (cdr (assoc '--host fields))))
 289              (p (cdr (assoc '--prefix fields)))
 290              )
 291         ;; No longer test for prefixes.
 292         (when (not (and v h))
 293           (let ((strs (split-string S "\n")))
 294             (message "Test failed on %S\nV H P:\n%S %S %S" (car strs) v h p))
 295           (setq fail t))
 296         ))
 297     (dolist (S semantic-gcc-test-strings-fail)
 298       (let* ((fields (semantic-gcc-fields S))
 299              (v (cdr (assoc 'version fields)))
 300              (h (or (cdr (assoc '--host fields))
 301                     (cdr (assoc 'target fields))))
 302              (p (cdr (assoc '--prefix fields)))
 303              )
 304         (when (and v h p)
 305           (message "Negative test failed on %S" S)
 306           (setq fail t))
 307         ))
 308     (if (not fail) (message "Tests passed."))
 309     ))
 310
 311 (defun semantic-gcc-test-output-parser-this-machine ()
 312   "Test the output parser against the machine currently running Emacs."
 313   (interactive)
 314   (let ((semantic-gcc-test-strings (list (semantic-gcc-query "gcc" "-v"))))
 315     (semantic-gcc-test-output-parser))
 316   )
 317
 318 (provide 'semantic/bovine/gcc)
 319 ;;; semantic/bovine/gcc.el ends here