From: Vincent Belaïche Date: Thu, 13 Jul 2017 18:58:22 +0000 (+0200) Subject: Add tests for SES, and fix one more cell renaming bug. X-Git-Tag: emacs-26.0.90~518^2~123 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b048351a0f01124b770d6584c3797fde67e30793;p=emacs.git 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. --- diff --git a/lisp/ses.el b/lisp/ses.el index 741d588e4be..5c560efb703 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 00000000000..5250ff43b7f --- /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 + +;; 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 . + +;;; 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 "\\" 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)