[Emacs-diffs] master b048351 1/2: Add tests for SES, and fix one more cell renaming bug.

[Vincent Belaïche]

branch: master
commit b048351a0f01124b770d6584c3797fde67e30793
Author: Vincent Belaïche <address@hidden>
Commit: Vincent Belaïche <address@hidden>

    Add tests for SES, and fix one more cell renaming bug.
    
    * lisp/ses.el (ses-relocate-all): In case of insertion, do not
    relocate value for named cells as they keep the same symbol.
    (ses-rename-cell): Set new cell name symbol to cell value --- do not
    rely on recalculating.  Push cells with updated data --- cell name,
    cell reference list, or cell formula --- to deferred write list.
    
    * test/lisp/ses-tests.el: New file, with 7 tests for SES.
---
 lisp/ses.el            |  48 +++++++++-------
 test/lisp/ses-tests.el | 151 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 180 insertions(+), 19 deletions(-)

diff --git a/lisp/ses.el b/lisp/ses.el
index 741d588..5c560ef 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1715,7 +1715,7 @@ to each symbol."
                     (set (make-local-variable sym) nil)
                     (put sym 'ses-cell (cons row col)))))) )))
     ;; Relocate the cell values.
-    (let (oldval myrow mycol xrow xcol)
+    (let (oldval myrow mycol xrow xcol sym)
       (cond
        ((and (<= rowincr 0) (<= colincr 0))
        ;; Deletion of rows and/or columns.
@@ -1725,16 +1725,16 @@ to each symbol."
          (dotimes (col (- ses--numcols mincol))
            (setq mycol  (+ col mincol)
                  xrow   (- myrow rowincr)
-                 xcol   (- mycol colincr))
-           (let ((sym (ses-cell-symbol myrow mycol)))
-             ;; We don't need to relocate value for renamed cells, as they 
keep the same
-             ;; symbol.
-             (unless (eq (get sym 'ses-cell) :ses-named)
-               (ses-set-cell myrow mycol 'value
-                             (if (and (< xrow ses--numrows) (< xcol 
ses--numcols))
-                                 (ses-cell-value xrow xcol)
-                               ;; Cell is off the end of the array.
-                               (symbol-value (ses-create-cell-symbol xrow 
xcol))))))))
+                 xcol   (- mycol colincr)
+                  sym (ses-cell-symbol myrow mycol))
+           ;; We don't need to relocate value for renamed cells, as they keep 
the same
+           ;; symbol.
+           (unless (eq (get sym 'ses-cell) :ses-named)
+             (ses-set-cell myrow mycol 'value
+                           (if (and (< xrow ses--numrows) (< xcol 
ses--numcols))
+                               (ses-cell-value xrow xcol)
+                             ;; Cell is off the end of the array.
+                             (symbol-value (ses-create-cell-symbol xrow 
xcol)))))))
        (when ses--in-killing-named-cell-list
          (message "Unbinding killed named cell symbols...")
          (setq ses-start-time (float-time))
@@ -1754,13 +1754,17 @@ to each symbol."
            (dotimes (col (- ses--numcols mincol))
              (setq mycol (- distx col)
                    xrow  (- myrow rowincr)
-                   xcol  (- mycol colincr))
-             (if (or (< xrow minrow) (< xcol mincol))
-                 ;; Newly-inserted value.
-                 (setq oldval nil)
-               ;; Transfer old value.
-               (setq oldval (ses-cell-value xrow xcol)))
-             (ses-set-cell myrow mycol 'value oldval)))
+                   xcol  (- mycol colincr)
+                    sym (ses-cell-symbol myrow mycol))
+             ;; We don't need to relocate value for renamed cells, as they 
keep the same
+             ;; symbol.
+             (unless (eq (get sym 'ses-cell) :ses-named)
+               (if (or (< xrow minrow) (< xcol mincol))
+                   ;; Newly-inserted value.
+                   (setq oldval nil)
+                 ;; Transfer old value.
+                 (setq oldval (ses-cell-value xrow xcol)))
+               (ses-set-cell myrow mycol 'value oldval))))
          t))  ; Make testcover happy by returning non-nil here.
        (t
        (error "ROWINCR and COLINCR must have the same sign"))))
@@ -3496,9 +3500,10 @@ highlighted range in the spreadsheet."
         (rowcol (ses-sym-rowcol sym))
         (row (car rowcol))
         (col (cdr rowcol))
-        new-rowcol old-name)
+        new-rowcol old-name old-value)
     (setq cell (or cell (ses-get-cell row col))
          old-name (ses-cell-symbol cell)
+          old-value (symbol-value old-name)
          new-rowcol (ses-decode-cell-symbol (symbol-name new-name)))
     ;; when ses-rename-cell is called interactively, then 'sym' is the
     ;; 'cursor-intangible' property of text at cursor position, while
@@ -3518,10 +3523,12 @@ highlighted range in the spreadsheet."
       (put new-name 'ses-cell :ses-named)
       (puthash new-name rowcol ses--named-cell-hashmap))
     (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
+    (cl-pushnew rowcol ses--deferred-write :test #'equal)
     ;; Replace name by new name in formula of cells refering to renamed cell.
     (dolist (ref (ses-cell-references cell))
       (let* ((x (ses-sym-rowcol ref))
             (xcell  (ses-get-cell (car x) (cdr x))))
+        (cl-pushnew x ses--deferred-write :test #'equal)
        (setf (ses-cell-formula xcell)
               (ses-replace-name-in-formula
                (ses-cell-formula xcell)
@@ -3532,11 +3539,14 @@ highlighted range in the spreadsheet."
     (dolist (ref (ses-formula-references (ses-cell-formula cell)))
       (let* ((x (ses-sym-rowcol ref))
             (xcell (ses-get-cell (car x) (cdr x))))
+        (cl-pushnew x ses--deferred-write :test #'equal)
        (setf (ses-cell-references xcell)
               (cons new-name (delq old-name
                                    (ses-cell-references xcell))))))
     (set (make-local-variable new-name) (symbol-value sym))
     (setf (ses-cell--symbol cell) new-name)
+    ;; set new name to value
+    (set new-name old-value)
     ;; Unbind old name
     (if (eq (get old-name 'ses-cell) :ses-named)
         (ses--unbind-cell-name old-name)
diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el
new file mode 100644
index 0000000..5250ff4
--- /dev/null
+++ b/test/lisp/ses-tests.el
@@ -0,0 +1,151 @@
+;;; ses-tests.el --- Tests for ses.el              -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+
+;; Author: Vincent Belaïche <address@hidden>
+
+;; 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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'ses)
+
+
+;; PLAIN FORMULA TESTS
+;; ======================================================================
+
+(ert-deftest ses-tests-lowlevel-plain-formula ()
+  "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value
+equal to 2. This is done with low level functions calls, not like
+interactively."
+  (let ((ses-initial-size '(2 . 1)))
+    (with-temp-buffer
+      (ses-mode)
+      (dolist (c '((0 0 1) (1 0 (1+ A1))))
+        (apply 'ses-cell-set-formula c)
+        (apply 'ses-calculate-cell (list (car c) (cadr c) nil)))
+      (should (eq A2 2)))))
+
+(ert-deftest ses-tests-plain-formula ()
+  "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value
+equal to 2. This is done  using interactive calls."
+  (let ((ses-initial-size '(2 . 1)))
+    (with-temp-buffer
+      (ses-mode)
+      (dolist (c '((0 0 1) (1 0 (1+ A1))))
+        (apply 'funcall-interactively 'ses-edit-cell c))
+      (ses-command-hook)
+      (should (eq A2 2)))))
+
+;; PLAIN CELL RENAMING TESTS
+;; ======================================================================
+
+(ert-deftest ses-tests-lowlevel-renamed-cell ()
+  "Check that renaming A1 to `foo' and setting `foo' to 1 and A2 to (1+ foo), 
makes A2 value equal to 2.
+This is done using low level functions, `ses-rename-cell' is not
+called but instead we use text replacement in the buffer priorly
+passed in text mode."
+  (let ((ses-initial-size '(2 . 1)))
+    (with-temp-buffer
+      (ses-mode)
+      (dolist (c '((0 0 1) (1 0 (1+ A1))))
+        (apply 'ses-cell-set-formula c)
+        (apply 'ses-calculate-cell (list (car c) (cadr c) nil)))
+      (ses-write-cells)
+      (text-mode)
+      (goto-char (point-min))
+      (while (re-search-forward "\\<A1\\>" nil t)
+        (replace-match "foo" t t))
+      (ses-mode)
+      (should-not  (local-variable-p 'A1))
+      (should (eq foo 1))
+      (should (equal (ses-cell-formula 1 0) '(ses-safe-formula (1+ foo))))
+      (should (eq A2 2)))))
+
+(ert-deftest ses-tests-renamed-cell ()
+  "Check that renaming A1 to `foo' and setting `foo' to 1 and A2
+to (1+ foo), makes A2 value equal to 2."
+  (let ((ses-initial-size '(2 . 1)))
+    (with-temp-buffer
+      (ses-mode)
+      (ses-rename-cell 'foo (ses-get-cell 0 0))
+      (dolist (c '((0 0 1) (1 0 (1+ foo))))
+        (apply 'funcall-interactively 'ses-edit-cell c))
+      (ses-command-hook)
+      (should-not  (local-variable-p 'A1))
+      (should (eq foo 1))
+      (should (equal (ses-cell-formula 1 0) '(1+ foo)))
+      (should (eq A2 2)))))
+
+(ert-deftest ses-tests-renamed-cell-after-setting ()
+  "Check that setting A1 to 1 and A2 to (1+ A1), and then
+renaming A1 to `foo' makes `foo' value equal to 2."
+  (let ((ses-initial-size '(2 . 1)))
+    (with-temp-buffer
+      (ses-mode)
+      (dolist (c '((0 0 1) (1 0 (1+ A1))))
+        (apply 'funcall-interactively 'ses-edit-cell c))
+      (ses-command-hook); deferred recalc
+      (ses-rename-cell 'foo (ses-get-cell 0 0))
+      (should-not  (local-variable-p 'A1))
+      (should (eq foo 1))
+      (should (equal (ses-cell-formula 1 0) '(1+ foo)))
+      (should (eq A2 2)))))
+
+;; ROW INSERTION TESTS
+;; ======================================================================
+
+(ert-deftest ses-tests-plain-row-insertion ()
+  "Check that setting A1 to 1 and A2 to (1+ A1), and then jumping
+to A2 and inserting a row, makes A2 value empty, and A3 equal to
+2."
+  (let ((ses-initial-size '(2 . 1)))
+    (with-temp-buffer
+      (ses-mode)
+      (dolist (c '((0 0 1) (1 0 (1+ A1))))
+        (apply 'funcall-interactively 'ses-edit-cell c))
+      (ses-command-hook)
+      (ses-jump 'A2)
+      (ses-insert-row 1)
+      (ses-command-hook)
+      (should-not A2)
+      (should (eq A3 2)))))
+
+; (defvar ses-tests-trigger nil)
+
+(ert-deftest ses-tests-renamed-cells-row-insertion ()
+  "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `foo' 
and A2 to `bar' jumping
+to `bar' and inserting a row, makes A2 value empty, and `bar' equal to
+2."
+  (setq ses-tests-trigger nil)
+  (let ((ses-initial-size '(2 . 1)))
+    (with-temp-buffer
+      (ses-mode)
+      (dolist (c '((0 0 1) (1 0 (1+ A1))))
+        (apply 'funcall-interactively 'ses-edit-cell c))
+      (ses-command-hook)
+      (ses-rename-cell 'foo (ses-get-cell 0 0))
+      (ses-command-hook)
+      (ses-rename-cell 'bar (ses-get-cell 1 0))
+      (ses-command-hook)
+      (should (eq bar 2))
+      (ses-jump 'bar)
+      (ses-insert-row 1)
+      (ses-command-hook)
+      (should-not A2)
+      (should (eq bar 2)))))
+
+
+(provide 'ses-tests)