lisp/cedet/semantic/db-debug.el

   1 ;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
   2
   3 ;;; Copyright (C) 2008-2017 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 ;; Various routines for debugging SemanticDB issues, or viewing
  25 ;; semanticdb state.
  26
  27 (require 'data-debug)
  28 (require 'semantic/db)
  29 (require 'semantic/format)
  30
  31 ;;; Code:
  32 ;;
  33 (defun semanticdb-dump-all-table-summary ()
  34   "Dump a list of all databases in Emacs memory."
  35   (interactive)
  36   (require 'data-debug)
  37   (let ((db semanticdb-database-list))
  38     (data-debug-new-buffer "*SEMANTICDB*")
  39     (data-debug-insert-stuff-list db "*")))
  40
  41 (defalias 'semanticdb-adebug-database-list 'semanticdb-dump-all-table-summary)
  42
  43 (defun semanticdb-adebug-current-database ()
  44   "Run ADEBUG on the current database."
  45   (interactive)
  46   (require 'data-debug)
  47   (let ((p semanticdb-current-database)
  48         )
  49     (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
  50     (data-debug-insert-stuff-list p "*")))
  51
  52 (defun semanticdb-adebug-current-table ()
  53   "Run ADEBUG on the current database."
  54   (interactive)
  55   (require 'data-debug)
  56   (let ((p semanticdb-current-table))
  57     (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
  58     (data-debug-insert-stuff-list p "*")))
  59
  60
  61 (defun semanticdb-adebug-project-database-list ()
  62   "Run ADEBUG on the current database."
  63   (interactive)
  64   (require 'data-debug)
  65   (let ((p (semanticdb-current-database-list)))
  66     (data-debug-new-buffer "*SEMANTICDB ADEBUG*")
  67     (data-debug-insert-stuff-list p "*")))
  68
  69
  70 \f
  71 ;;; Sanity Checks
  72 ;;
  73
  74 (defun semanticdb-table-oob-sanity-check (cache)
  75   "Validate that CACHE tags do not have any overlays in them."
  76   (while cache
  77     (when (semantic-overlay-p (semantic-tag-overlay cache))
  78       (message "Tag %s has an erroneous overlay!"
  79                (semantic-format-tag-summarize (car cache))))
  80     (semanticdb-table-oob-sanity-check
  81      (semantic-tag-components-with-overlays (car cache)))
  82     (setq cache (cdr cache))))
  83
  84 (defun semanticdb-table-sanity-check (&optional table)
  85   "Validate the current semanticdb TABLE."
  86   (interactive)
  87   (if (not table) (setq table semanticdb-current-table))
  88   (let* ((full-filename (semanticdb-full-filename table))
  89          (buff (find-buffer-visiting full-filename)))
  90     (if buff
  91         (with-current-buffer buff
  92           (semantic-sanity-check))
  93       ;; We can't use the usual semantic validity check, so hack our own.
  94       (semanticdb-table-oob-sanity-check (semanticdb-get-tags table)))))
  95
  96 (defun semanticdb-database-sanity-check ()
  97   "Validate the current semantic database."
  98   (interactive)
  99   (let ((tables (semanticdb-get-database-tables
 100                  semanticdb-current-database)))
 101     (while tables
 102       (semanticdb-table-sanity-check (car tables))
 103       (setq tables (cdr tables)))
 104     ))
 105
 106
 107
 108 (provide 'semantic/db-debug)
 109
 110 ;;; semantic/db-debug.el ends here