;;;; Example of usage:
;;;;      (demo-parse-test-suite "demo-test-suite.el")

(defmacro nm-deftest-parametrized
    (prefix-sym func-predicate &rest doc-cases)
  "Define parametrized test

For each SUFFIX, CASE-DOCSTRING, EXPECTATION, ARGS list
call `ert-deftest' with SUITE--SUFFIX name, CASE-DOCSTRING,
and `should' that checks whether EXPECTATION is consistent
with result of FUNCTION applied to ARGS using PREDICATE or `equal'.

\(fn SUITE (FUNCTION [PREDICATE])  \
  [SUITE-DOCSTRING] \
  (SUFFIX CASE-DOCSTRING EXPECTATION ARGS...)...)"
  (declare (debug (&define [&name "test@" symbolp] sexp
			   [&optional strinp] def-body))
	   (indent 2)
	   (doc-string 3))
  (let* ((func (car func-predicate))
	 (predicate (or (cadr func-predicate) (symbol-function 'equal)))
	 (prefix (symbol-name prefix-sym))
	 (maybe-doc (car doc-cases))
	 (cases (if (stringp maybe-doc) (cdr doc-cases) doc-cases))
	 (case-list (mapcar
		     (lambda (case)
		       (format "- `%s--%s'"
			       prefix
			       (symbol-name (car case))))
		     cases))
	 ;; Unfortunately `ert-describe-test' works only in ert mode
	 ;; and links to particular subtests are inactive.
	 (suite-doc (if (stringp maybe-doc)
			(cons maybe-doc case-list)
		      case-list)))
    (append
     `(,#'progn
	;; A function to assing doc string that is linked from each test.
	(defun ,prefix-sym () ,(mapconcat #'identity suite-doc "\n")))
     (mapcar
      (lambda (case)
	;; Have not managed to express "&rest" using `pcase-let'.
	(apply (lambda (id-sym case-docstring expectation &rest args)
		 (let* ((id (symbol-name id-sym))
			(name (intern (concat prefix "--" id)))
			(docstring (format "%s (`%s')" case-docstring prefix)))
		   `(ert-deftest ,name ()
		      ,docstring
		      (should (funcall ,predicate ,expectation
				     (apply ,func (quote ,args)))))))
	       case))
      cases))))

(defun demo-test-parse-input (text)
  (with-temp-buffer
    (insert text)
    (org-mode)
    (test-org-element-parser-generate-syntax-sexp)))

(defmacro demo-parse-test-suite (file-name)
  (let* ((prefix (file-name-base file-name))
	 (prefix-sym (intern (concat "demo-parse-test/" prefix)))
	 (suite (with-temp-buffer
		  (insert-file-contents file-name)
		  (read (current-buffer))))
	 (case-list (plist-get suite :cases))
	 (suite-description (plist-get suite :description)))
    `(nm-deftest-parametrized
	 ,prefix-sym (#'demo-test-parse-input)
       ,suite-description
       ,@(mapcar (lambda (case)
		  (list (plist-get case :id)
			(or (plist-get case :description) "Warning: no description for this case")
			`(quote ,(plist-get case :result))
			(plist-get case :input)))
		case-list))))