Function: ert-font-lock--parse-comments

ert-font-lock--parse-comments is a byte-compiled function defined in ert-font-lock.el.gz.

Signature

(ert-font-lock--parse-comments)

Documentation

Read test assertions from comments in the current buffer.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/ert-font-lock.el.gz
(defun ert-font-lock--parse-comments ()
  "Read test assertions from comments in the current buffer."
  (let ((tests '())
        (curline 1)
        (linetocheck -1))

    (goto-char (point-min))

    ;; Go through all lines, for comments check if there are
    ;; assertions. For non-comment and comment/non-assert lines
    ;; remember the last line seen.
    (while (not (eobp))
      (catch 'nextline

        ;; Not a comment? remember the line, move to the next one
        (unless (ert-font-lock--line-comment-p)
          (setq linetocheck curline)
          (throw 'nextline t))

        ;; A comment. Not an assertion? remember the line to be
        ;; checked, move to the next line
        (unless (ert-font-lock--line-assertion-p)
          (setq linetocheck curline)
          (throw 'nextline t))


        ;; Collect the first line assertion (caret or arrow)
        (when (re-search-forward ert-font-lock--assertion-line-re
                                 (line-end-position) t 1)

          (unless (> linetocheck -1)
            (user-error "Invalid test comment syntax at line %d. Expected a line to test before the comment line" curline))

          ;; construct a test
          (let* (;; either comment start char column (for arrows) or
                 ;; caret column
                 (column-checked (if (equal (match-string-no-properties 1) "^")
                                     (- (match-beginning 1) (line-beginning-position))
                                   (ert-font-lock--get-first-char-column)))
                 ;; negate the face?
                 (negation (string-equal (match-string-no-properties 3) "!"))
                 ;; the face that is supposed to be in the position specified
                 (face (read (match-string-no-properties 4))))

            ;; Collect the first assertion on the line
            (push (list :line-checked linetocheck
                        :line-assert curline
                        :column-checked column-checked
                        :face face
                        :negation negation)
                  tests)

            ;; Collect all the other line carets (if present)
            (goto-char (match-beginning 2))
            (while (equal (following-char) ?^)
              (setq column-checked (- (point) (line-beginning-position)))
              (push (list :line-checked linetocheck
                          :line-assert curline
                          :column-checked column-checked
                          :face face
                          :negation negation)
                    tests)
              (forward-char)
              (skip-syntax-forward " ")))))

      ;; next line
      (setq curline (1+ curline))
      (forward-line 1))

    (unless tests
      (user-error "No test assertions found"))

    (reverse tests)))