Browse Source

Add ERT for table alignment within Org buffer

* testing/lisp/test-org-table.el (test-org-table/align): New
ert-deftest for table alignment within Org buffer.
* testing/org-test.el (org-test-table-target-expect): New defun.

The new function org-test-table-target-expect is to simplify writing
spreadsheet ERT by providing just a target table to apply the formula
to, the expected result table and the table formula with optionally
additional variants.  The variants typically are to check the same
result with a Lisp formula and a Calc formula.  test-org-table.el is
also a howto example collection as a user documentation.
Michael Brand 12 years ago
parent
commit
ce1a8465b5
2 changed files with 66 additions and 0 deletions
  1. 14 0
      testing/lisp/test-org-table.el
  2. 52 0
      testing/org-test.el

+ 14 - 0
testing/lisp/test-org-table.el

@@ -23,6 +23,20 @@
 ;; Template test file for Org-mode tests
 
 ;;; Code:
+
+(ert-deftest test-org-table/align ()
+  "Align columns within Org buffer, depends on `org-table-number-regexp'."
+  (org-test-table-target-expect "
+| 0  |  0 |    0 |       0 |       0 |           0 |       0 |    0 |
+| ab | 12 | 12.2 | 2.4e-08 | 2x10^12 | 4.034+-0.02 | 2.7(10) | >3.5 |
+| ab | ab |   ab |      ab |      ab |          ab |      ab |   ab |
+")
+  (org-test-table-target-expect "
+| 0          | 0           |   0 | 0    | 0    | 0   |
+| <-0x0ab.cf | >-36#0vw.yz | nan | uinf | -inf | inf |
+| ab         | ab          |  ab | ab   | ab   | ab  |
+"))
+
 (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
   "Simple reference @1$1."
   (should

+ 52 - 0
testing/org-test.el

@@ -220,6 +220,58 @@ otherwise place the point at the beginning of the inserted text."
        ,results)))
 (def-edebug-spec org-test-with-temp-text-in-file (form body))
 
+(defun org-test-table-target-expect (target &optional expect laps
+&rest tblfm)
+  "For all TBLFM: Apply the formula to TARGET, compare EXPECT with result.
+Either LAPS and TBLFM are nil and the table will only be aligned
+or LAPS is the count of recalculations that should be made on
+each TBLFM.  To save ERT run time keep LAPS as low as possible to
+get the table stable.  Anyhow, if LAPS is 'iterate then iterate,
+but this will run one recalculation longer.  When EXPECT is nil
+it will be set to TARGET.
+
+If running a test interactively in ERT is not enough and you need
+to examine the target table with e. g. the Org formula debugger
+or an Emacs Lisp debugger (e. g. with point in a data field and
+calling the instrumented `org-table-eval-formula') then copy and
+paste the table with formula from the ERT results buffer or
+temporarily substitute the `org-test-with-temp-text' of this
+function with `org-test-with-temp-text-in-file'.
+
+Consider setting `pp-escape-newlines' to nil manually."
+  (require 'pp)
+  (let ((back pp-escape-newlines) (current-tblfm))
+    (unless tblfm
+      (should-not laps)
+      (push "" tblfm))  ; Dummy formula.
+    (unless expect (setq expect target))
+    (while (setq current-tblfm (pop tblfm))
+      (org-test-with-temp-text (concat target current-tblfm)
+	;; Search table, stop ERT at end of buffer if not found.
+	(while (not (org-at-table-p))
+	  (should (eq 0 (forward-line))))
+	(when laps
+	  (if (and (symbolp laps) (eq laps 'iterate))
+	      (should (org-table-recalculate 'iterate t))
+	    (should (integerp laps))
+	    (should (< 0 laps))
+	    (let ((cnt laps))
+	      (while (< 0 cnt)
+		(should (org-table-recalculate 'all t))
+		(setq cnt (1- cnt))))))
+	(org-table-align)
+	(setq pp-escape-newlines nil)
+	;; Declutter the ERT results buffer by giving only variables
+	;; and not directly the forms to `should'.
+	(let ((expect (concat expect current-tblfm))
+	      (result (buffer-substring-no-properties
+		       (point-min) (point-max))))
+	  (should (equal expect result)))
+	;; If `should' passed then set back `pp-escape-newlines' here,
+	;; else leave it nil as a side effect to see the failed table
+	;; on multiple lines in the ERT results buffer.
+	(setq pp-escape-newlines back)))))
+
 
 ;;; Navigation Functions
 (when (featurep 'jump)