From ae78cf0ee117414a8b9784ce1abd24cdf185a720 Mon Sep 17 00:00:00 2001 From: David Engster Date: Sun, 25 Jan 2015 23:05:25 +0100 Subject: [PATCH] Tests: Add ERT test for the C Bovinator * tests/cedet-utests.el (cedet/semantic/ert/test-c-parser): Require. (cedet-utest-test-alist): Add new ERT test. * tests/cedet/semantic/ert/test-c-parser.el: New file for testing the C Bovinator. This tests the newly added typed enum rule. --- .../cedet/cedet/semantic/ert/test-c-parser.el | 199 ++++++++++++++++++ 1 file changed, 199 insertions(+) create mode 100644 test/manual/cedet/cedet/semantic/ert/test-c-parser.el diff --git a/test/manual/cedet/cedet/semantic/ert/test-c-parser.el b/test/manual/cedet/cedet/semantic/ert/test-c-parser.el new file mode 100644 index 00000000000..050da7fb5b7 --- /dev/null +++ b/test/manual/cedet/cedet/semantic/ert/test-c-parser.el @@ -0,0 +1,199 @@ +;;; test-c-parser.el --- Testing the C Bovinator +;; +;; Copyright (C) 2015 Free Software Foundation, Inc. +;; +;; Author: David Engster +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +(require 'ert) + +(defun semantic-c-parser-test-ert () + (ert-run-tests-batch "test-c-parser-.*")) + +;; Generate Tags + +(defvar test-c-parser-temp-file + (make-temp-file "test-c-parser" nil ".cpp")) + +(defun test-c-parser-bovinate (str) + (with-current-buffer (find-file-noselect test-c-parser-temp-file) + (unless (semantic-active-p) + (semantic-mode 1)) + (erase-buffer) + (insert str "\n") + (semantic-fetch-tags))) + +;; Test helpers + +(defun test-c-parser-remove-from-plist (element plist) + (let (new) + (while (and plist + (not (eq (car plist) element))) + (setq new (append new (list (car plist) + (cadr plist)))) + (setq plist (cddr plist))) + (when plist + (setq plist (cddr plist))) + (when plist + (setq new (append new plist))) + new)) + +(defsubst test-c-parser-list-of-tags-p (tags) + (and (listp tags) (semantic-tag-p (car tags)))) + +(defun test-c-parser-compare-attributes (actual expected &optional ignore) + (let ((actualattr (semantic-tag-attributes actual)) + (expectattr (semantic-tag-attributes expected))) + ;; :type is always ignored by default, as it is checked separately. + (unless (member :type ignore) + (setq ignore (append ignore '(:type)))) + ;; Remove all ignored attributes. + (dolist (cur ignore) + (setq actualattr (test-c-parser-remove-from-plist cur actualattr)) + (setq expectattr (test-c-parser-remove-from-plist cur expectattr))) + ;; Check attributes. + (while expectattr + (let ((attrname (car expectattr)) + (attrval (nth 1 expectattr))) + (should (test-c-attribute-exists attrname actualattr)) + (should (test-c-attribute-value attrval + (plist-get actualattr attrname) + attrname)) + (setq actualattr + (test-c-parser-remove-from-plist attrname actualattr))) + (setq expectattr (cddr expectattr))) + (should (test-c-parser-no-attributes-left actualattr)))) + +(defun test-c-parser-no-attributes-left (remaining) + (null remaining)) + +(defun test-c-attribute-exists (name actualattr) + (member name actualattr)) + +(defun test-c-attribute-value (expect actual name) + ;; List of tags have to be checked recursively. + (if (and (test-c-parser-list-of-tags-p expect) + (test-c-parser-list-of-tags-p actual)) + (progn + (while expect + (test-c-parser-compare-tag (car expect) + (car actual)) + (setq expect (cdr expect) + actual (cdr actual))) + t) + (equal expect actual))) + +(defun test-c-check-tags-length (tags expect) + (= (length tags) expect)) + +(defun test-c-parser-compare-tag (actual expect) + ;; Check that it is a tag. + (should (semantic-tag-p actual)) + ;; Check name. + (should (string= (semantic-tag-name actual) + (semantic-tag-name expect))) + ;; Check class. + (should (semantic-tag-of-class-p + actual + (semantic-tag-class expect))) + ;; Check type. + (should (semantic-tag-of-type-p + actual + (semantic-tag-type expect))) + ;; Compare attributes. + (test-c-parser-compare-attributes actual expect)) + +;;; ERT explainers + +(put 'test-c-check-tags-length 'ert-explainer + (lambda (tags expect) + (format "Wrong number of tags. Expected: %d, actual: %d." + expect (length tags)))) + +(put 'test-c-parser-no-attributes-left 'ert-explainer + (lambda (remaining) + (format "Tag has unexpected attribute(s): %s." + (prin1-to-string remaining)))) + +(put 'test-c-attribute-exists 'ert-explainer + (lambda (name attributes) + (format "Tag is missing attribute: %s." + (symbol-name name)))) + +(put 'test-c-attribute-value 'ert-explainer + (lambda (expect actual name) + (format "Wrong value for attribute %s. Expected: %s, actual: %s." + (symbol-name name) + (prin1-to-string expect) + (prin1-to-string actual)))) + +(put 'semantic-tag-p 'ert-explainer + (lambda (tag) + (if (null tag) + "Parser returned nil for expression." + "Parser did not return valid tag."))) + +(put 'semantic-tag-of-class-p 'ert-explainer + (lambda (tag class) + (format "Wrong class. Expected: %s, actual: %s." + (symbol-name class) + (semantic-tag-class tag)))) + +(put 'semantic-tag-of-type-p 'ert-explainer + (lambda (tag type) + (format "Wrong type. Expected: %s, actual: %s" + (semantic-tag-type tag) type))) + +;;; Tests + +;;;; Enum + +(ert-deftest test-c-parser-enum-01 () + (let ((actual + (test-c-parser-bovinate "enum foo { RED, GREEN, BLUE };")) + (expect '("foo" type + (:members + (("RED" variable + (:constant-flag t :type "int")) + ("GREEN" variable + (:constant-flag t :type "int")) + ("BLUE" variable + (:constant-flag t :type "int"))) + :type "enum")))) + (should (test-c-check-tags-length actual 1)) + (setq actual (car actual)) + (test-c-parser-compare-tag actual expect))) + +(ert-deftest test-c-parser-enum-02-typed () + (let ((actual + (test-c-parser-bovinate "enum foo : unsigned { RED, GREEN, BLUE };")) + (expect '("foo" type + (:enum-type + "unsigned int" + :members + (("RED" variable + (:constant-flag t :type "unsigned int")) + ("GREEN" variable + (:constant-flag t :type "unsigned int")) + ("BLUE" variable + (:constant-flag t :type "unsigned int"))) + :type "enum")))) + (should (test-c-check-tags-length actual 1)) + (setq actual (car actual)) + (test-c-parser-compare-tag actual expect))) + +(provide 'cedet/semantic/ert/test-c-parser) -- 2.39.5