1 ;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 ;; Free Software Foundation, Inc.
6 ;; Author: Jonathan Yavner <jyavner@engineer.com>
7 ;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
8 ;; Keywords: spreadsheet lisp utility
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 (defvar ses-initial-global-parameters)
30 (declare-function ses-set-curcell "ses")
31 (declare-function ses-update-cells "ses")
32 (declare-function ses-load "ses")
33 (declare-function ses-vector-delete "ses")
34 (declare-function ses-create-header-string "ses")
35 (declare-function ses-read-cell "ses")
36 (declare-function ses-read-symbol "ses")
37 (declare-function ses-command-hook "ses")
38 (declare-function ses-jump "ses")
41 ;;;Here are some macros that exercise SES. Set `pause' to t if you want the
42 ;;;macros to pause after each step.
44 (x (if pause "
\18q" ""))
45 (y "
\18\ 6ses-test.ses\r
\e<"))
46 ;;Fiddle with the existing spreadsheet
47 (fset 'ses-exercise-example
48 (concat "
\18\ 6" data-directory "ses-example.ses\r
\e<"
52 x "
\10\10\ 6pses-center\r"
63 x "(+
\18o
\ e\ e\ 6\0
\ 6\ 6"
64 x "
\15-1
\18o
\ 3\12 \ 3\13\r
\ 2"
67 ;;Create a new spreadsheet
68 (fset 'ses-exercise-new
86 (fset 'ses-exercise-display
87 (concat y "
\e:(revert-buffer t t)\r"
113 x "
\ 2\ 2\ 2\"1234567-1234567-1234567\r
\ 2"
116 x "
\ e\"1234567-1234567-1234567\r
\ 2"
119 x "
\ 2\ 2\"1234567\r"
123 (fset 'ses-exercise-formulas
124 (concat y "
\e:(revert-buffer t t)\r"
129 x "
\ e(apply '+ (ses-range B1 B3)\r
\ 2"
130 x "(apply 'ses+ (ses-range B1 B3)\r
\ 2"
131 x "
\ e(apply 'ses+ (ses-range A2 A3)\r
\ 2"
132 x "
\ e(mapconcat'number-to-string(ses-range B2 B4) \"-\"\r
\ 2"
133 x "
\ 2(apply 'concat (reverse (ses-range A3 D3))\r
\ 2"
134 x "
\ 2(* (+ A2 A3) (ses+ B2 B3)\r
\ 2"
138 x "
\10(apply 'ses+ (ses-range E1 E2)\r
\ 2"
139 x "
\10(apply 'ses+ (ses-range A5 B5)\r
\ 2"
140 x "
\10(apply 'ses+ (ses-range E1 F1)\r
\ 2"
141 x "
\10(apply 'ses+ (ses-range D1 E1)\r
\ 2"
143 x "(ses-average (ses-range A2 A5)\r
\ 2"
144 x "
\ e(apply 'ses+ (ses-range A5 A6)\r
\ 2"
153 x "
\ 6(ses-average (ses-range B3 E3)\r
\ 2"
155 x "
\ e\1012345678\r
\ 2"
157 ;;Recalculating and reconstructing
158 (fset 'ses-exercise-recalc
159 (concat y "
\e:(revert-buffer t t)\r"
169 x "
\e>
\18nw
\ 6\ 6\ 6"
170 x "\0
\e>
\exdelete-region\r"
173 x "\0
\e>
\exdelete-region\r"
184 x "
\ 2\ 2\"Very long2\r"
188 x "
\ e\r
\7f\7f\7fC2\r"
189 x "
\10\0
\ e\ 6\ 3\ 3"
191 x "
\ e\ e\r
\7f\7f\7fC2\r"
199 (fset 'ses-exercise-header-row
200 (concat y "
\e:(revert-buffer t t)\r"
215 ;;Detecting unsafe formulas and printers
216 (fset 'ses-exercise-unsafe
217 (concat y "
\e:(revert-buffer t t)\r"
218 x "p(lambda (x) (delete-file x))\rn"
219 x "p(lambda (x) (delete-file \"ses-nothing\"))\ry"
221 x "
\ e(delete-file \"x\"\rn"
222 x "(delete-file \"ses-nothing\"\ry
\ 2"
224 x "(open-network-stream \"x\" nil \"localhost\" \"smtp\"\ry
\ 2"
227 ;;Inserting and deleting rows
228 (fset 'ses-exercise-rows
229 (concat y "
\e:(revert-buffer t t)\r"
239 x "
\10\10(not B25\r
\ 2"
244 x "
\15100
\ f" ;Make this approx your CPU speed in MHz
246 ;;Inserting and deleting columns
247 (fset 'ses-exercise-columns
248 (concat y "
\e:(revert-buffer t t)\r"
269 x "\0
\ e\ e\ 6\ 6\ 3\e\13D"
271 (fset 'ses-exercise-editing
272 (concat y "
\e:(revert-buffer t t)\r"
274 x "
\ 6(
\ 2'
\ 6x\r
\ 2"
289 x "
\ 2\"Very long\r
\ 2"
302 x "\"Also very long\r
\ 2"
306 x "
\ e\ 2'qwerty\r
\ 2"
307 x "
\ 6(concat
\18o
\e<\0
\ e\ e"
308 x "
\15-1
\18o
\ 3\12\r
\ 2"
309 x "(apply '+
\18o
\e<\0
\ e\ 6\15-1
\18o
\ 3\13\r
\ 2"
317 x "\"Another long one\r
\ 2"
326 (fset 'ses-exercise-sort-column
327 (concat y "
\e:(revert-buffer t t)\r"
333 x "\0
\10\10\10\ 3\e\13A\r"
334 x "
\ e\0
\10\10\10\ 3\e\13B\r"
335 x "
\10\10\ 6\0
\ e\ e\ 6\ 6\ 3\e\13C\r"
337 x "
\ 2\0
\ e\ e\ e\15\ 3\e\13C\r"
339 ;;Simple cell printers
340 (fset 'ses-exercise-cell-printers
341 (concat y "
\e:(revert-buffer t t)\r"
342 x "
\ 6\"4
\11\t76\r
\ 2"
356 x "
\ 2\0
\ 6\ 6pnil\r"
364 x "
\ 3\10\"%.6g#\"\r"
365 x "
\ 3\10\"%.6g.\"\r"
366 x "
\ 3\10\"%.6g.\"\r"
372 x "p(lambda
\11 (x)
\11 '(\"Hi\"))\r"
373 x "p(lambda
\11 (x)
\11 '(\"Bye\"))\r"
375 ;;Spanning cell printers
376 (fset 'ses-exercise-spanning-printers
377 (concat y "
\e:(revert-buffer t t)\r"
379 x "pses-dashfill-span\r"
381 x "pses-tildefill-span\r"
387 x "\t\"12345678\r
\ 2"
388 x "pses-dashfill-span\r"
403 ;;Cut/copy/paste - within same buffer
404 (fset 'ses-exercise-paste-1buf
405 (concat y "
\e:(revert-buffer t t)\r"
424 x "
\ 6pses-dashfill\r"
425 x "
\ 2\0
\ 6\ 6\ 6\ e\ e\ e"
431 x "
\153
\10(+ G2 H1\r"
435 x "
\ 2\158
\10(ses-average (ses-range G2 H2)\r
\ 2"
439 x "
\10\ 2(ses-average (ses-range E7 E9)\r
\ 2"
442 x "
\ 2\ 2\10(ses-average (ses-range E7 F7)\r
\ 2"
445 x "
\ 2\ 2\10(ses-average (ses-range D6 E6)\r
\ 2"
450 x "pses-tildefill-span\r"
451 x "
\ e\ 6\"Subline A(1)\r
\ 2"
452 x "pses-dashfill-span\r"
453 x "
\ 2\10\0
\ e\ e\ e\ew
\ 3\ 3"
454 x "
\ 1\10\10\10\10\10\10"
456 x "\0
\ e\ 6\ 6\ew
\ 3\ 3"
459 ;;Cut/copy/paste - between two buffers
460 (fset 'ses-exercise-paste-2buf
461 (concat y "
\e:(revert-buffer t t)\r"
462 x "
\ 6\ e\eo\"middle\r
\ 2\0
\ 6\ e\ 6"
464 x "
\184bses-test.txt\r"
466 x "
\ 5\"xxx\0
\ 2\ 2\ 2\ 2"
470 x "
\18o
\ 5\"\0
\ 2\ 2\ 2\ 2\ 2"
472 x "
\18o123.45\0
\ 2\ 2\ 2\ 2\ 2\ 2"
474 x "
\18o1
\ 2\ 2\0
\ 6\ 6\ 6\ 6\ 6\ 6\ 6"
477 x "
\ 6\18o symb\0
\ 2\ 2\ 2\ 2"
478 x "
\17\18o
\15\19\ey
\152
\ey"
481 x "w9\n
\ep\"<%s>\"\n"
482 x "
\18o\n2\t\"3\nxxx\t5\n\0
\10\10"
485 ;;Export text, import it back
486 (fset 'ses-exercise-import-export
487 (concat y "
\e:(revert-buffer t t)\r"
489 x "
\184bses-test.txt\r"
491 x "xT
\18o
\19\15-1
\18o"
492 x "
\ 3\ 3\ 6'crunch\r
\ 2"
493 x "
\10\10\10pses-center-span\r"
495 x "
\18o\n
\19\15-1
\18o"
504 (defun ses-exercise-macros ()
505 "Executes all SES coverage-test macros."
506 (dolist (x '(ses-exercise-example
509 ses-exercise-formulas
511 ses-exercise-header-row
516 ses-exercise-sort-column
517 ses-exercise-cell-printers
518 ses-exercise-spanning-printers
519 ses-exercise-paste-1buf
520 ses-exercise-paste-2buf
521 ses-exercise-import-export))
522 (message "<Testing %s>" x)
523 (execute-kbd-macro x)))
525 (defun ses-exercise-signals ()
526 "Exercise code paths that lead to error signals, other than those for
527 spreadsheet files with invalid formatting."
528 (message "<Checking for expected errors>")
529 (switch-to-buffer "ses-test.ses")
533 (dolist (x '((ses-column-widths 14)
534 (ses-column-printers "%s")
535 (ses-column-printers ["%s" "%s" "%s"]) ;Should be two
536 (ses-column-widths [14])
537 (ses-delete-column -99)
538 (ses-delete-column 2)
540 (ses-goto-data 'hogwash)
543 (ses-insert-column -14)
545 (ses-jump 'B8) ;Covered by preceding cell
546 (ses-printer-validate '("%s" t))
547 (ses-printer-validate '([47]))
548 (ses-read-header-row -1)
549 (ses-read-header-row 32767)
550 (ses-relocate-all 0 0 -1 1)
551 (ses-relocate-all 0 0 1 -1)
552 (ses-select (ses-range A1 A2) 'x (ses-range B1 B1))
553 (ses-set-cell 0 0 'hogwash nil)
554 (ses-set-column-width 0 0)
555 (ses-yank-cells #("a\nb"
556 0 1 (ses (A1 nil nil))
557 2 3 (ses (A3 nil nil)))
559 (ses-yank-cells #("ab"
560 0 1 (ses (A1 nil nil))
561 1 2 (ses (A2 nil nil)))
564 (ses-yank-tsf "1\t2\n3" nil)
565 (let ((curcell nil)) (ses-check-curcell))
566 (let ((curcell 'A1)) (ses-check-curcell 'needrange))
567 (let ((curcell '(A1 . A2))) (ses-check-curcell 'end))
568 (let ((curcell '(A1 . A2))) (ses-sort-column "B"))
569 (let ((curcell '(C1 . D2))) (ses-sort-column "B"))
570 (execute-kbd-macro "jB10\n
\152
\ 4")
571 (execute-kbd-macro [?j ?B ?9 ?\n ?\C-@ ?\C-f ?\C-f cut])
572 (progn (kill-new "x") (execute-kbd-macro "
\e>
\19n"))
573 (execute-kbd-macro "
\ 2\0
\ew")))
577 (signal 'singularity-error nil)) ;Shouldn't get here
578 (singularity-error (error "No error from %s?" x))
580 ;;Test quit-handling in ses-update-cells. Cant' use `eval' here.
581 (let ((inhibit-quit t))
585 (ses-update-cells '(A1))
586 (signal 'singularity-error nil))
587 (singularity-error (error "Quit failure in ses-update-cells"))
589 (setq quit-flag nil)))
591 (defun ses-exercise-invalid-spreadsheets ()
592 "Execute code paths that detect invalid spreadsheet files."
593 ;;Detect invalid spreadsheets
594 (let ((p&d "\n\n
\f\n(ses-cell A1 nil nil nil nil)\n\n")
595 (cw "(ses-column-widths [7])\n")
596 (cp "(ses-column-printers [ses-center])\n")
597 (dp "(ses-default-printer \"%.7g\")\n")
598 (hr "(ses-header-row 0)\n")
600 (igp ses-initial-global-parameters))
601 (dolist (x (list "(1)"
609 "\n\n
\f\n(ses-cell)(2 1 1)"
610 "\n\n
\f\n(x)\n(2 1 1)"
611 "\n\n\n
\f\n(ses-cell A2)\n(2 2 2)"
612 "\n\n\n
\f\n(ses-cell B1)\n(2 2 2)"
613 "\n\n
\f\n(ses-cell A1 nil nil nil nil)\n(2 1 1)"
614 (concat p&d "(x)\n(x)\n(x)\n(x)\n" p11)
615 (concat p&d "(ses-column-widths)(x)\n(x)\n(x)\n" p11)
616 (concat p&d cw "(x)\n(x)\n(x)\n(2 1 1)")
617 (concat p&d cw "(ses-column-printers)(x)\n(x)\n" p11)
618 (concat p&d cw cp "(x)\n(x)\n" p11)
619 (concat p&d cw cp "(ses-default-printer)(x)\n" p11)
620 (concat p&d cw cp dp "(x)\n" p11)
621 (concat p&d cw cp dp "(ses-header-row)" p11)
622 (concat p&d cw cp dp hr p11)
623 (concat p&d cw cp dp "\n" hr igp)))
628 (signal 'singularity-error nil)) ;Shouldn't get here
629 (singularity-error (error "%S is an invalid spreadsheet!" x))
632 (defun ses-exercise-startup ()
633 "Prepare for coverage tests"
634 ;;Clean up from any previous runs
635 (condition-case nil (kill-buffer "ses-example.ses") (error nil))
636 (condition-case nil (kill-buffer "ses-test.ses") (error nil))
637 (condition-case nil (delete-file "ses-test.ses") (file-error nil))
638 (delete-other-windows) ;Needed for "\C-xo" in ses-exercise-editing
639 (setq ses-mode-map nil) ;Force rebuild
640 (testcover-unmark-all "ses.el")
642 (let ((testcover-1value-functions
643 ;;forward-line always returns 0, for us.
644 ;;remove-text-properties always returns t for us.
645 ;;ses-recalculate-cell returns the same " " any time curcell is a cons
646 ;;Macros ses-dorange and ses-dotimes-msg generate code that always
648 (append '(forward-line remove-text-properties ses-recalculate-cell
649 ses-dorange ses-dotimes-msg)
650 testcover-1value-functions))
652 ;;These maps get initialized, then never changed again
653 (append '(ses-mode-map ses-mode-print-map ses-mode-edit-map)
654 testcover-constants)))
655 (testcover-start "ses.el" t))
656 (require 'unsafep)) ;In case user has safe-functions = t!
659 ;;;#########################################################################
660 (defun ses-exercise ()
661 "Executes all SES coverage tests and displays the results."
663 (ses-exercise-startup)
664 ;;Run the keyboard-macro tests
665 (let ((safe-functions nil)
666 (ses-initial-size '(1 . 1))
667 (ses-initial-column-width 7)
668 (ses-initial-default-printer "%.7g")
669 (ses-after-entry-functions '(forward-char))
671 (ses-exercise-macros)
672 (ses-exercise-signals)
673 (ses-exercise-invalid-spreadsheets)
674 ;;Upgrade of old-style spreadsheet
676 (insert " \n\n
\f\n(ses-cell A1 nil nil nil nil)\n\n(ses-column-widths [7])\n(ses-column-printers [nil])\n(ses-default-printer \"%.7g\")\n\n( ;Global parameters (these are read first)\n 1 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n")
678 ;;ses-vector-delete is always called from buffer-undo-list with the same
679 ;;symbol as argument. We'll give it a different one here.
681 (ses-vector-delete 'x 0 0))
682 ;;ses-create-header-string behaves differently in a non-window environment
683 ;;but we always test under windows.
684 (let ((window-system (not window-system)))
686 (ses-create-header-string))
687 ;;Test for nonstandard after-entry functions
688 (let ((ses-after-entry-functions '(forward-line))
690 (ses-read-cell 0 0 1)
691 (ses-read-symbol 0 0 t)))
692 ;;Tests with unsafep disabled
693 (let ((safe-functions t)
695 (message "<Checking safe-functions = t>")
696 (kill-buffer "ses-example.ses")
697 (find-file "ses-example.ses"))
698 ;;Checks for nonstandard default values for new spreadsheets
700 (dolist (x '(("%.6g" 8 (2 . 2))
702 (let ((ses-initial-size (nth 2 x))
703 (ses-initial-column-width (nth 1 x))
704 (ses-initial-default-printer (nth 0 x)))
706 (set-buffer-modified-p t)
708 ;;Test error-handling in command hook, outside a macro.
709 ;;This will ring the bell.
710 (let (curcell-overlay)
712 ;;Due to use of run-with-timer, ses-command-hook sometimes gets called
713 ;;after we switch to another buffer.
714 (switch-to-buffer "*scratch*")
717 (message "<Marking source code>")
718 (testcover-mark-all "ses.el")
719 (testcover-next-mark)
721 (delete-other-windows)
722 (kill-buffer "ses-test.txt")
723 ;;Could do this here: (testcover-end "ses.el")
726 ;;; arch-tag: 87052ba4-5cf8-46cf-9375-fe245f3360b8
727 ;; testcover-ses.el ends here.