+2003-12-29 Eli Zaretskii <eliz@elta.co.il>
+
+ * emacs-lisp/tcover-unsafep.el, emacs-lisp/tcover-ses.el: Renamed
+ from testcover-unsafep.el and testcover-ses.el to avoid file-name
+ clashes on 8+3 DOS filesystems.
+
2003-12-29 Richard M. Stallman <rms@gnu.org>
* textmodes/flyspell.el (mail-mode-flyspell-verify):
--- /dev/null
+;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Jonathan Yavner <jyavner@engineer.com>
+;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
+;; Keywords: spreadsheet lisp utility
+
+;; GNU Emacs 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 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+(require 'testcover)
+
+;;;Here are some macros that exercise SES. Set `pause' to t if you want the
+;;;macros to pause after each step.
+(let* ((pause nil)
+ (x (if pause "\18q" ""))
+ (y "\18\ 6ses-test.ses\r\e<"))
+ ;;Fiddle with the existing spreadsheet
+ (fset 'ses-exercise-example
+ (concat "\18\ 6" data-directory "ses-example.ses\r\e<"
+ x "\1510\ e"
+ x "\v"
+ x "\1f"
+ x "\10\10\ 6pses-center\r"
+ x "\ 6p\r"
+ x "\15\10\t\t"
+ x "\r\ 2 A9 B9\r"
+ x "\15\ e\ 2\ 2\ 2"
+ x "\r\ 1\v2\r"
+ x "\ e\ e\ 6"
+ x "50\r"
+ x "\154\1f"
+ x "\ 3\e\f"
+ x "\1f"
+ x "(+ \18o\ e\ e\ 6\0\ 6\ 6"
+ x "\15-1\18o\ 3\12 \ 3\13\r\ 2"
+ x "\1f"
+ x))
+ ;;Create a new spreadsheet
+ (fset 'ses-exercise-new
+ (concat y
+ x "\ 3\10\"%.8g\"\r"
+ x "2\r"
+ x "\ f"
+ x "\10"
+ x "\152\ f"
+ x "\"Header\r"
+ x "(sqrt 1\r\ 2"
+ x "pses-center\r\ 6"
+ x "\t"
+ x "\10(+ A2 A3\r"
+ x "\ 6(* B2 A3\r"
+ x "\152\ 3\e\b"
+ x "\r\7f\7f\7fB3\r"
+ x "\18\13"
+ x))
+ ;;Basic cell display
+ (fset 'ses-exercise-display
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ 5"
+ x "\"Very long\r\ 2"
+ x "w3\r"
+ x "w3\r"
+ x "(/ 1 0\r\ 2"
+ x "234567\r\ 2"
+ x "\155w"
+ x "\t1\r\ 2"
+ x "\ 2\ 3\ 3"
+ x "\ 6234567\r\ 2"
+ x "\t\ 4\ 2"
+ x "\ 2\ 3\ 3"
+ x "345678\r\ 2"
+ x "\153w"
+ x "\0\e>"
+ x "\ 3\ 3"
+ x "\18\18"
+ x "\ 5"
+ x "\18\18\ 1"
+ x "\ 5"
+ x "\ 6\ 5"
+ x "\ 3\ 3"
+ x "1\r\ 2"
+ x "\ 3\ 3\ 6"
+ x "\ 5"
+ x "\ 2\ 2\ 2\"1234567-1234567-1234567\r\ 2"
+ x "123\r\ 2"
+ x "\152\ f"
+ x "\ e\"1234567-1234567-1234567\r\ 2"
+ x "123\r\ 2"
+ x "\ 6\ 6w8\r"
+ x "\ 2\ 2\"1234567\r"
+ x "\ e\ 2w5\r"
+ x))
+ ;;Cell formulas
+ (fset 'ses-exercise-formulas
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\t\t"
+ x "\t"
+ x "(* B1 B2 D1\r\ 2"
+ x "(* B2 B3\r\ 2"
+ x "\ e(apply '+ (ses-range B1 B3)\r\ 2"
+ x "(apply 'ses+ (ses-range B1 B3)\r\ 2"
+ x "\ e(apply 'ses+ (ses-range A2 A3)\r\ 2"
+ x "\ e(mapconcat'number-to-string(ses-range B2 B4) \"-\"\r\ 2"
+ x "\ 2(apply 'concat (reverse (ses-range A3 D3))\r\ 2"
+ x "\ 2(* (+ A2 A3) (ses+ B2 B3)\r\ 2"
+ x "\ e"
+ x "\152\ f"
+ x "\155\t"
+ x "\10(apply 'ses+ (ses-range E1 E2)\r\ 2"
+ x "\10(apply 'ses+ (ses-range A5 B5)\r\ 2"
+ x "\10(apply 'ses+ (ses-range E1 F1)\r\ 2"
+ x "\10(apply 'ses+ (ses-range D1 E1)\r\ 2"
+ x "\t"
+ x "(ses-average (ses-range A2 A5)\r\ 2"
+ x "\ e(apply 'ses+ (ses-range A5 A6)\r\ 2"
+ x "\ 2\ 2\ek"
+ x "\ e\ e\v"
+ x "\10\10\10\ f"
+ x "\ e\152\ f"
+ x "\10\153\v"
+ x "\ 2\ 2\ 2\eo"
+ x "\ 6\152\eo"
+ x "\ 2\153\ek"
+ x "\ 6(ses-average (ses-range B3 E3)\r\ 2"
+ x "\ 2\ek"
+ x "\ e\1012345678\r\ 2"
+ x))
+ ;;Recalculating and reconstructing
+ (fset 'ses-exercise-recalc
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ 3\e\f"
+ x "\t\t"
+ x "\ 3\ 3"
+ x "(/ 1 0\r\ 2"
+ x "\ 3\ 3"
+ x "\n"
+ x "\ 3\ 3"
+ x "\ 3\10\"%.6g\"\r"
+ x "\ 3\e\f"
+ x "\e>\18nw\ 6\ 6\ 6"
+ x "\0\e>\exdelete-region\r"
+ x "\ 3\e\f"
+ x "\158\ e"
+ x "\0\e>\exdelete-region\r"
+ x "\ 3\e\f"
+ x "\ 3\ e"
+ x "\ e\v\ 2\ek"
+ x "\ 3\f"
+ x "\ 2\"Very long\r"
+ x "\10\ 3\14"
+ x "\ 2\r\r"
+ x "\ e\ 3\14"
+ x "\ 6\eo"
+ x "\ 6\ 3\14"
+ x "\ 2\ 2\"Very long2\r"
+ x "\ 2\eo\ 6"
+ x "\ 3\14"
+ x "\r\7f\7f\7fC3\r"
+ x "\ e\r\7f\7f\7fC2\r"
+ x "\10\0\ e\ 6\ 3\ 3"
+ x "\r\7f\7fC4\r"
+ x "\ e\ e\r\7f\7f\7fC2\r"
+ x "\ 6\0\ 2\10\10"
+ x "\ 3\ 3"
+ x "\exses-mode\r"
+ x "\e<\ f"
+ x "\152\ek"
+ x))
+ ;;Header line
+ (fset 'ses-exercise-header-row
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\18<"
+ x "\18>"
+ x "\156\18<"
+ x "\18>"
+ x "\157\18<"
+ x "\18>"
+ x "\158\18<"
+ x "\152\18<"
+ x "\18>"
+ x "\ 6\153w\ 2"
+ x "\1510\18<"
+ x "\18>"
+ x "\152\v"
+ x))
+ ;;Detecting unsafe formulas and printers
+ (fset 'ses-exercise-unsafe
+ (concat y "\e:(revert-buffer t t)\r"
+ x "p(lambda (x) (delete-file x))\rn"
+ x "p(lambda (x) (delete-file \"ses-nothing\"))\ry"
+ x "\0\ 6\17\19n"
+ x "\ e(delete-file \"x\"\rn"
+ x "(delete-file \"ses-nothing\"\ry\ 2"
+ x "\0\ 6\17\19n"
+ x "(open-network-stream \"x\" nil \"localhost\" \"smtp\"\ry\ 2"
+ x "\0\ 6\17\19n"
+ x))
+ ;;Inserting and deleting rows
+ (fset 'ses-exercise-rows
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ e\ 6"
+ x "\ 3\10\"%s=\"\r"
+ x "\1520\ f"
+ x "\ep\"%s+\"\r"
+ x "\ e\ f"
+ x "123456789\r\ 2"
+ x "\0\1521\ e\ 6"
+ x "\ 3\ 3"
+ x "\e\f"
+ x "\10\10(not B25\r\ 2"
+ x "\ e\ek"
+ x "jA3\r"
+ x "\1519\v"
+ x "\10\ 6\v"
+ x "\15100\ f" ;Make this approx your CPU speed in MHz
+ x))
+ ;;Inserting and deleting columns
+ (fset 'ses-exercise-columns
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ 3\10\"%s@\"\r"
+ x "\eo"
+ x "\ f"
+ x "\eo"
+ x "\v"
+ x "\ek"
+ x "w8\r"
+ x "\ep\"%.7s*\"\r"
+ x "\eo"
+ x "\ 6"
+ x "\152\eo"
+ x "\153\ek"
+ x "\ 3\10\"%.6g\"\r"
+ x "\1526\eo"
+ x "\0\1526\t"
+ x "\1526\eo"
+ x "\ 3\e\b0\r"
+ x "\1526\t"
+ x "\15400\ 2"
+ x "\1550\ek"
+ x "\0\ e\ e\ 6\ 6\ 3\e\13D"
+ x))
+ (fset 'ses-exercise-editing
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ e\ e\ e1\r\ 2"
+ x "\ 6(\ 2'\ 6x\r\ 2"
+ x "\ 2\10\10\10\ f"
+ x "\1f"
+ x "\r\r"
+ x "w9\r"
+ x "\ e\r\ 2.5\r"
+ x "\ e\ 6\r\ 2 10\r"
+ x "w12\r"
+ x "\r\ 1'\r"
+ x "\r\ 1\ 4\r"
+ x "jA4\r"
+ x "(+ A2 100\r\ 2"
+ x "\10\103\r\ 2"
+ x "jB1\r"
+ x "(not A1\r\ 2"
+ x "\ 2\"Very long\r\ 2"
+ x "\ 3\ 3"
+ x "\eh"
+ x "\eH"
+ x "\ 3\ 3"
+ x "\e>\t"
+ x "\10\10\ 4"
+ x "\10\ 4"
+ x "\ 6\ 6\152\7f"
+ x "\10\7f"
+ x "\eo"
+ x "\eh"
+ x "\0\ f\ 6"
+ x "\"Also very long\r\ 2"
+ x "\ e\ 6\eH"
+ x "\0'\r\ 2"
+ x "'Trial\r\ 2"
+ x "\ e\ 2'qwerty\r\ 2"
+ x "\ 6(concat \18o\e<\0\ e\ e"
+ x "\15-1\18o\ 3\12\r\ 2"
+ x "(apply '+ \18o\e<\0\ e\ 6\15-1\18o\ 3\13\r\ 2"
+ x "\10\152\7f"
+ x "\15-2\7f"
+ x "\15-2\ 4"
+ x "\152\ 4"
+ x "\ 2\10\10\v"
+ x "\ e\ 6\eH"
+ x "\ 2\10\0\ f"
+ x "\"Another long one\r\ 2"
+ x "\ e\ e\ 6\eH"
+ x "\ 1\10\ 5"
+ x "\ 3\ 3\e<"
+ x "\ e\ 5"
+ x "\e>\10\ f"
+ x "\0\ 5\ 6\ 5"
+ x))
+ ;;Sorting of columns
+ (fset 'ses-exercise-sort-column
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\"Very long\r"
+ x "\ 699\r"
+ x "\ 6\eo13\r"
+ x "(+ A3 B3\r"
+ x "7\r8\r(* A4 B4\r"
+ x "\0\10\10\10\ 3\e\13A\r"
+ x "\ e\0\10\10\10\ 3\e\13B\r"
+ x "\10\10\ 6\0\ e\ e\ 6\ 6\ 3\e\13C\r"
+ x "\ 6\eo\10\ f"
+ x "\ 2\0\ e\ e\ e\15\ 3\e\13C\r"
+ x))
+ ;;Simple cell printers
+ (fset 'ses-exercise-cell-printers
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ 6\"4\11\t76\r\ 2"
+ x "\"4\11\n7\r\ 2"
+ x "p\"{%S}\"\r"
+ x "p(\"[%s]\")\r"
+ x "p(\"<%s>\")\r"
+ x "\ 2\0\ 6\ 6"
+ x "p\r"
+ x "pnil\r"
+ x "pses-dashfill\r"
+ x "48\r\ 2"
+ x "\t"
+ x "\ 2\0\ 6p\r"
+ x "\ 6p\r"
+ x "pses-dashfill\r"
+ x "\ 2\0\ 6\ 6pnil\r"
+ x "5\r\ 2"
+ x "pses-center\r"
+ x "\ 3\10\"%s\"\r"
+ x "w8\r"
+ x "\ep\r"
+ x "\ep\"%.7g@\"\r"
+ x "\ 3\10\r"
+ x "\ 3\10\"%.6g#\"\r"
+ x "\ 3\10\"%.6g.\"\r"
+ x "\ 3\10\"%.6g.\"\r"
+ x "\epidentity\r"
+ x "6\r\ 2"
+ x "\ e\"UPCASE\r\ 2"
+ x "\epdowncase\r"
+ x "(* 3 4\r\ 2"
+ x "p(lambda\11 (x)\11 '(\"Hi\"))\r"
+ x "p(lambda\11 (x)\11 '(\"Bye\"))\r"
+ x))
+ ;;Spanning cell printers
+ (fset 'ses-exercise-spanning-printers
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ep\"%.6g*\"\r"
+ x "pses-dashfill-span\r"
+ x "5\r\ 2"
+ x "pses-tildefill-span\r"
+ x "\"4\r\ 2"
+ x "\ep\"$%s\"\r"
+ x "\ep(\"$%s\")\r"
+ x "8\r\ 2"
+ x "\ep(\"!%s!\")\r"
+ x "\t\"12345678\r\ 2"
+ x "pses-dashfill-span\r"
+ x "\"23456789\r\ 2"
+ x "\t"
+ x "(not t\r\ 2"
+ x "\ 2w6\r"
+ x "\"5\r\ 2"
+ x "\ e\ 6\eo"
+ x "\ek"
+ x "\ek"
+ x "\t"
+ x "\ 2\10\ 3\ 3"
+ x "\eo"
+ x "\ e\152\ek"
+ x "\ 2\ 2\ek"
+ x))
+ ;;Cut/copy/paste - within same buffer
+ (fset 'ses-exercise-paste-1buf
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ e\0\ 6\ew"
+ x "\ 3\ 3\10\ 6\19"
+ x "\ e\eo"
+ x "\"middle\r\ 2"
+ x "\0\ 6\ e\ 6"
+ x "\ew"
+ x "\10\0\ 6"
+ x "\ew"
+ x "\ 3\ 3\ 6\ e"
+ x "\19"
+ x "\152\19y"
+ x "\ 6\15\19y"
+ x "\10\10\ 6\15\19y"
+ x "\e>"
+ x "\19y"
+ x "\e>\19y"
+ x "\e<"
+ x "p\"<%s>\"\r"
+ x "\ 6pses-dashfill\r"
+ x "\ 2\0\ 6\ 6\ 6\ e\ e\ e"
+ x "\17"
+ x "\1f"
+ x "\15\19y"
+ x "\r\0\ 2\ 2\ 2\ew"
+ x "\r\ 6\19"
+ x "\153\10(+ G2 H1\r"
+ x "\0\ 2\ew"
+ x "\ 3\ 3\e>\ 2"
+ x "\19"
+ x "\ 2\158\10(ses-average (ses-range G2 H2)\r\ 2"
+ x "\0\ 6\17\ek"
+ x "\157\ e"
+ x "\19"
+ x "\10\ 2(ses-average (ses-range E7 E9)\r\ 2"
+ x "\0\ 6\17\v"
+ x "\ e\19"
+ x "\ 2\ 2\10(ses-average (ses-range E7 F7)\r\ 2"
+ x "\0\ 6\17\ek"
+ x "\ 6\19"
+ x "\ 2\ 2\10(ses-average (ses-range D6 E6)\r\ 2"
+ x "\0\ 6\17\ek"
+ x "\ 6\19"
+ x "\ 1\152\ f"
+ x "\"Line A\r\ 2"
+ x "pses-tildefill-span\r"
+ x "\ e\ 6\"Subline A(1)\r\ 2"
+ x "pses-dashfill-span\r"
+ x "\ 2\10\0\ e\ e\ e\ew\ 3\ 3"
+ x "\ 1\10\10\10\10\10\10"
+ x "\19"
+ x "\0\ e\ 6\ 6\ew\ 3\ 3"
+ x "\ 6\19"
+ x))
+ ;;Cut/copy/paste - between two buffers
+ (fset 'ses-exercise-paste-2buf
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ 6\ e\eo\"middle\r\ 2\0\ 6\ e\ 6"
+ x "\17"
+ x "\184bses-test.txt\r"
+ x " \ 1\19"
+ x "\ 5\"xxx\0\ 2\ 2\ 2\ 2"
+ x "\ew\18o"
+ x "\1f"
+ x "\19"
+ x "\18o\ 5\"\0\ 2\ 2\ 2\ 2\ 2"
+ x "\ew\18o\19"
+ x "\18o123.45\0\ 2\ 2\ 2\ 2\ 2\ 2"
+ x "\17\18o\19"
+ x "\18o1 \ 2\ 2\0\ 6\ 6\ 6\ 6\ 6\ 6\ 6"
+ x "\17\18o\19"
+ x "\e>\19y"
+ x "\ 6\18o symb\0\ 2\ 2\ 2\ 2"
+ x "\17\18o\15\19\ey\152\ey"
+ x "\18o1\t\0\ 2\ 2"
+ x "\17\18o\ 2\19"
+ x "w9\n\ep\"<%s>\"\n"
+ x "\18o\n2\t\"3\nxxx\t5\n\0\10\10"
+ x "\17\18o\19y"
+ x))
+ ;;Export text, import it back
+ (fset 'ses-exercise-import-export
+ (concat y "\e:(revert-buffer t t)\r"
+ x "\ e\ e\ 6\0\ 6xt"
+ x "\184bses-test.txt\r"
+ x "\n\19\15-1\18o"
+ x "xT\18o\19\15-1\18o"
+ x "\ 3\ 3\ 6'crunch\r\ 2"
+ x "\10\10\10pses-center-span\r"
+ x "\0\ e\ e\ e\ exT"
+ x "\18o\n\19\15-1\18o"
+ x "\0\19y"
+ x "\ 6\0\ 2\10\10xt"
+ x "\ e\ e\0\15\19y"
+ x "12345678\r\ 2"
+ x "\ 6\ 6'bunch\r"
+ x "\0\10\10xtxT"
+ x)))
+
+(defun ses-exercise-macros ()
+ "Executes all SES coverage-test macros."
+ (dolist (x '(ses-exercise-example
+ ses-exercise-new
+ ses-exercise-display
+ ses-exercise-formulas
+ ses-exercise-recalc
+ ses-exercise-header-row
+ ses-exercise-unsafe
+ ses-exercise-rows
+ ses-exercise-columns
+ ses-exercise-editing
+ ses-exercise-sort-column
+ ses-exercise-cell-printers
+ ses-exercise-spanning-printers
+ ses-exercise-paste-1buf
+ ses-exercise-paste-2buf
+ ses-exercise-import-export))
+ (message "<Testing %s>" x)
+ (execute-kbd-macro x)))
+
+(defun ses-exercise-signals ()
+ "Exercise code paths that lead to error signals, other than those for
+spreadsheet files with invalid formatting."
+ (message "<Checking for expected errors>")
+ (switch-to-buffer "ses-test.ses")
+ (deactivate-mark)
+ (ses-jump 'A1)
+ (ses-set-curcell)
+ (dolist (x '((ses-column-widths 14)
+ (ses-column-printers "%s")
+ (ses-column-printers ["%s" "%s" "%s"]) ;Should be two
+ (ses-column-widths [14])
+ (ses-delete-column -99)
+ (ses-delete-column 2)
+ (ses-delete-row -1)
+ (ses-goto-data 'hogwash)
+ (ses-header-row -56)
+ (ses-header-row 99)
+ (ses-insert-column -14)
+ (ses-insert-row 0)
+ (ses-jump 'B8) ;Covered by preceding cell
+ (ses-printer-validate '("%s" t))
+ (ses-printer-validate '([47]))
+ (ses-read-header-row -1)
+ (ses-read-header-row 32767)
+ (ses-relocate-all 0 0 -1 1)
+ (ses-relocate-all 0 0 1 -1)
+ (ses-select (ses-range A1 A2) 'x (ses-range B1 B1))
+ (ses-set-cell 0 0 'hogwash nil)
+ (ses-set-column-width 0 0)
+ (ses-yank-cells #("a\nb"
+ 0 1 (ses (A1 nil nil))
+ 2 3 (ses (A3 nil nil)))
+ nil)
+ (ses-yank-cells #("ab"
+ 0 1 (ses (A1 nil nil))
+ 1 2 (ses (A2 nil nil)))
+ nil)
+ (ses-yank-pop nil)
+ (ses-yank-tsf "1\t2\n3" nil)
+ (let ((curcell nil)) (ses-check-curcell))
+ (let ((curcell 'A1)) (ses-check-curcell 'needrange))
+ (let ((curcell '(A1 . A2))) (ses-check-curcell 'end))
+ (let ((curcell '(A1 . A2))) (ses-sort-column "B"))
+ (let ((curcell '(C1 . D2))) (ses-sort-column "B"))
+ (execute-kbd-macro "jB10\n\152\ 4")
+ (execute-kbd-macro [?j ?B ?9 ?\n ?\C-@ ?\C-f ?\C-f cut])
+ (progn (kill-new "x") (execute-kbd-macro "\e>\19n"))
+ (execute-kbd-macro "\ 2\0\ew")))
+ (condition-case nil
+ (progn
+ (eval x)
+ (signal 'singularity-error nil)) ;Shouldn't get here
+ (singularity-error (error "No error from %s?" x))
+ (error nil)))
+ ;;Test quit-handling in ses-update-cells. Cant' use `eval' here.
+ (let ((inhibit-quit t))
+ (setq quit-flag t)
+ (condition-case nil
+ (progn
+ (ses-update-cells '(A1))
+ (signal 'singularity-error nil))
+ (singularity-error (error "Quit failure in ses-update-cells"))
+ (error nil))
+ (setq quit-flag nil)))
+
+(defun ses-exercise-invalid-spreadsheets ()
+ "Execute code paths that detect invalid spreadsheet files."
+ ;;Detect invalid spreadsheets
+ (let ((p&d "\n\n\f\n(ses-cell A1 nil nil nil nil)\n\n")
+ (cw "(ses-column-widths [7])\n")
+ (cp "(ses-column-printers [ses-center])\n")
+ (dp "(ses-default-printer \"%.7g\")\n")
+ (hr "(ses-header-row 0)\n")
+ (p11 "(2 1 1)")
+ (igp ses-initial-global-parameters))
+ (dolist (x (list "(1)"
+ "(x 2 3)"
+ "(1 x 3)"
+ "(1 -1 0)"
+ "(1 2 x)"
+ "(1 2 -1)"
+ "(3 1 1)"
+ "\n\n\f(2 1 1)"
+ "\n\n\f\n(ses-cell)(2 1 1)"
+ "\n\n\f\n(x)\n(2 1 1)"
+ "\n\n\n\f\n(ses-cell A2)\n(2 2 2)"
+ "\n\n\n\f\n(ses-cell B1)\n(2 2 2)"
+ "\n\n\f\n(ses-cell A1 nil nil nil nil)\n(2 1 1)"
+ (concat p&d "(x)\n(x)\n(x)\n(x)\n" p11)
+ (concat p&d "(ses-column-widths)(x)\n(x)\n(x)\n" p11)
+ (concat p&d cw "(x)\n(x)\n(x)\n(2 1 1)")
+ (concat p&d cw "(ses-column-printers)(x)\n(x)\n" p11)
+ (concat p&d cw cp "(x)\n(x)\n" p11)
+ (concat p&d cw cp "(ses-default-printer)(x)\n" p11)
+ (concat p&d cw cp dp "(x)\n" p11)
+ (concat p&d cw cp dp "(ses-header-row)" p11)
+ (concat p&d cw cp dp hr p11)
+ (concat p&d cw cp dp "\n" hr igp)))
+ (condition-case nil
+ (with-temp-buffer
+ (insert x)
+ (ses-load)
+ (signal 'singularity-error nil)) ;Shouldn't get here
+ (singularity-error (error "%S is an invalid spreadsheet!" x))
+ (error nil)))))
+
+(defun ses-exercise-startup ()
+ "Prepare for coverage tests"
+ ;;Clean up from any previous runs
+ (condition-case nil (kill-buffer "ses-example.ses") (error nil))
+ (condition-case nil (kill-buffer "ses-test.ses") (error nil))
+ (condition-case nil (delete-file "ses-test.ses") (file-error nil))
+ (delete-other-windows) ;Needed for "\C-xo" in ses-exercise-editing
+ (setq ses-mode-map nil) ;Force rebuild
+ (testcover-unmark-all "ses.el")
+ ;;Enable
+ (let ((testcover-1value-functions
+ ;;forward-line always returns 0, for us.
+ ;;remove-text-properties always returns t for us.
+ ;;ses-recalculate-cell returns the same " " any time curcell is a cons
+ ;;Macros ses-dorange and ses-dotimes-msg generate code that always
+ ;; returns nil
+ (append '(forward-line remove-text-properties ses-recalculate-cell
+ ses-dorange ses-dotimes-msg)
+ testcover-1value-functions))
+ (testcover-constants
+ ;;These maps get initialized, then never changed again
+ (append '(ses-mode-map ses-mode-print-map ses-mode-edit-map)
+ testcover-constants)))
+ (testcover-start "ses.el" t))
+ (require 'unsafep)) ;In case user has safe-functions = t!
+
+
+;;;#########################################################################
+(defun ses-exercise ()
+ "Executes all SES coverage tests and displays the results."
+ (interactive)
+ (ses-exercise-startup)
+ ;;Run the keyboard-macro tests
+ (let ((safe-functions nil)
+ (ses-initial-size '(1 . 1))
+ (ses-initial-column-width 7)
+ (ses-initial-default-printer "%.7g")
+ (ses-after-entry-functions '(forward-char))
+ (ses-mode-hook nil))
+ (ses-exercise-macros)
+ (ses-exercise-signals)
+ (ses-exercise-invalid-spreadsheets)
+ ;;Upgrade of old-style spreadsheet
+ (with-temp-buffer
+ (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")
+ (ses-load))
+ ;;ses-vector-delete is always called from buffer-undo-list with the same
+ ;;symbol as argument. We'll give it a different one here.
+ (let ((x [1 2 3]))
+ (ses-vector-delete 'x 0 0))
+ ;;ses-create-header-string behaves differently in a non-window environment
+ ;;but we always test under windows.
+ (let ((window-system (not window-system)))
+ (scroll-left 7)
+ (ses-create-header-string))
+ ;;Test for nonstandard after-entry functions
+ (let ((ses-after-entry-functions '(forward-line))
+ ses-mode-hook)
+ (ses-read-cell 0 0 1)
+ (ses-read-symbol 0 0 t)))
+ ;;Tests with unsafep disabled
+ (let ((safe-functions t)
+ ses-mode-hook)
+ (message "<Checking safe-functions = t>")
+ (kill-buffer "ses-example.ses")
+ (find-file "ses-example.ses"))
+ ;;Checks for nonstandard default values for new spreadsheets
+ (let (ses-mode-hook)
+ (dolist (x '(("%.6g" 8 (2 . 2))
+ ("%.8g" 6 (3 . 3))))
+ (let ((ses-initial-size (nth 2 x))
+ (ses-initial-column-width (nth 1 x))
+ (ses-initial-default-printer (nth 0 x)))
+ (with-temp-buffer
+ (set-buffer-modified-p t)
+ (ses-mode)))))
+ ;;Test error-handling in command hook, outside a macro.
+ ;;This will ring the bell.
+ (let (curcell-overlay)
+ (ses-command-hook))
+ ;;Due to use of run-with-timer, ses-command-hook sometimes gets called
+ ;;after we switch to another buffer.
+ (switch-to-buffer "*scratch*")
+ (ses-command-hook)
+ ;;Print results
+ (message "<Marking source code>")
+ (testcover-mark-all "ses.el")
+ (testcover-next-mark)
+ ;;Cleanup
+ (delete-other-windows)
+ (kill-buffer "ses-test.txt")
+ ;;Could do this here: (testcover-end "ses.el")
+ (message "Done"))
+
+;;; arch-tag: 87052ba4-5cf8-46cf-9375-fe245f3360b8
+;; testcover-ses.el ends here.
--- /dev/null
+;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
+
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Jonathan Yavner <jyavner@engineer.com>
+;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
+;; Keywords: safety lisp utility
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+(require 'testcover)
+
+;;;These forms are all considered safe
+(defconst testcover-unsafep-safe
+ '(((lambda (x) (* x 2)) 14)
+ (apply 'cdr (mapcar '(lambda (x) (car x)) y))
+ (cond ((= x 4) 5) (t 27))
+ (condition-case x (car y) (error (car x)))
+ (dolist (x y) (message "here: %s" x))
+ (dotimes (x 14 (* x 2)) (message "here: %d" x))
+ (let (x) (dolist (y '(1 2 3) (1+ y)) (push y x)))
+ (let (x) (apply '(lambda (x) (* x 2)) 14))
+ (let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2))
+ (let ((x 1) (y 2)) (setq x (+ x y)))
+ (let ((x 1)) (let ((y (+ x 3))) (* x y)))
+ (let* nil (current-time))
+ (let* ((x 1) (y (+ x 3))) (* x y))
+ (mapcar (lambda (x &optional y &rest z) (setq y (+ x 2)) (* y 3)) '(1 2 3))
+ (mapconcat #'(lambda (var) (propertize var 'face 'bold)) '("1" "2") ", ")
+ (setq buffer-display-count 14 mark-active t)
+ ;;This is not safe if you insert it into a buffer!
+ (propertize "x" 'display '(height (progn (delete-file "x") 1))))
+ "List of forms that `unsafep' should decide are safe.")
+
+;;;These forms are considered unsafe
+(defconst testcover-unsafep-unsafe
+ '(( (add-to-list x y)
+ . (unquoted x))
+ ( (add-to-list y x)
+ . (unquoted y))
+ ( (add-to-list 'y x)
+ . (global-variable y))
+ ( (not (delete-file "unsafep.el"))
+ . (function delete-file))
+ ( (cond (t (aset local-abbrev-table 0 0)))
+ . (function aset))
+ ( (cond (t (setq unsafep-vars "")))
+ . (risky-local-variable unsafep-vars))
+ ( (condition-case format-alist 1)
+ . (risky-local-variable format-alist))
+ ( (condition-case x 1 (error (setq format-alist "")))
+ . (risky-local-variable format-alist))
+ ( (dolist (x (sort globalvar 'car)) (princ x))
+ . (function sort))
+ ( (dotimes (x 14) (delete-file "x"))
+ . (function delete-file))
+ ( (let ((post-command-hook "/tmp/")) 1)
+ . (risky-local-variable post-command-hook))
+ ( (let ((x (delete-file "x"))) 2)
+ . (function delete-file))
+ ( (let (x) (add-to-list 'x (delete-file "x")))
+ . (function delete-file))
+ ( (let (x) (condition-case y (setq x 1 z 2)))
+ . (global-variable z))
+ ( (let (x) (condition-case z 1 (error (delete-file "x"))))
+ . (function delete-file))
+ ( (let (x) (mapc (lambda (x) (setcar x 1)) '((1 . 2) (3 . 4))))
+ . (function setcar))
+ ( (let (y) (push (delete-file "x") y))
+ . (function delete-file))
+ ( (let* ((x 1)) (setq y 14))
+ . (global-variable y))
+ ( (mapc 'car (list '(1 . 2) (cons 3 4) (kill-buffer "unsafep.el")))
+ . (function kill-buffer))
+ ( (mapcar x y)
+ . (unquoted x))
+ ( (mapcar '(lambda (x) (rename-file x "x")) '("unsafep.el"))
+ . (function rename-file))
+ ( (mapconcat x1 x2 " ")
+ . (unquoted x1))
+ ( (pop format-alist)
+ . (risky-local-variable format-alist))
+ ( (push 1 format-alist)
+ . (risky-local-variable format-alist))
+ ( (setq buffer-display-count (delete-file "x"))
+ . (function delete-file))
+ ;;These are actualy safe (they signal errors)
+ ( (apply '(x) '(1 2 3))
+ . (function (x)))
+ ( (let (((x))) 1)
+ . (variable (x)))
+ ( (let (1) 2)
+ . (variable 1))
+ )
+ "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.")
+
+
+;;;#########################################################################
+(defun testcover-unsafep ()
+ "Executes all unsafep tests and displays the coverage results."
+ (interactive)
+ (testcover-unmark-all "unsafep.el")
+ (testcover-start "unsafep.el")
+ (let (save-functions)
+ (dolist (x testcover-unsafep-safe)
+ (if (unsafep x)
+ (error "%S should be safe" x)))
+ (dolist (x testcover-unsafep-unsafe)
+ (if (not (equal (unsafep (car x)) (cdr x)))
+ (error "%S should be unsafe: %s" (car x) (cdr x))))
+ (setq safe-functions t)
+ (if (or (unsafep '(delete-file "x"))
+ (unsafep-function 'delete-file))
+ (error "safe-functions=t should allow delete-file"))
+ (setq safe-functions '(setcar))
+ (if (unsafep '(setcar x 1))
+ (error "safe-functions=(setcar) should allow setcar"))
+ (if (not (unsafep '(setcdr x 1)))
+ (error "safe-functions=(setcar) should not allow setcdr")))
+ (testcover-mark-all "unsafep.el")
+ (testcover-end "unsafep.el")
+ (message "Done"))
+
+;;; arch-tag: a7616c27-1998-47ae-9304-76d1439dbf29
+;; testcover-unsafep.el ends here.
+++ /dev/null
-;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Author: Jonathan Yavner <jyavner@engineer.com>
-;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
-;; Keywords: spreadsheet lisp utility
-
-;; GNU Emacs 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 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(require 'testcover)
-
-;;;Here are some macros that exercise SES. Set `pause' to t if you want the
-;;;macros to pause after each step.
-(let* ((pause nil)
- (x (if pause "\18q" ""))
- (y "\18\ 6ses-test.ses\r\e<"))
- ;;Fiddle with the existing spreadsheet
- (fset 'ses-exercise-example
- (concat "\18\ 6" data-directory "ses-example.ses\r\e<"
- x "\1510\ e"
- x "\v"
- x "\1f"
- x "\10\10\ 6pses-center\r"
- x "\ 6p\r"
- x "\15\10\t\t"
- x "\r\ 2 A9 B9\r"
- x "\15\ e\ 2\ 2\ 2"
- x "\r\ 1\v2\r"
- x "\ e\ e\ 6"
- x "50\r"
- x "\154\1f"
- x "\ 3\e\f"
- x "\1f"
- x "(+ \18o\ e\ e\ 6\0\ 6\ 6"
- x "\15-1\18o\ 3\12 \ 3\13\r\ 2"
- x "\1f"
- x))
- ;;Create a new spreadsheet
- (fset 'ses-exercise-new
- (concat y
- x "\ 3\10\"%.8g\"\r"
- x "2\r"
- x "\ f"
- x "\10"
- x "\152\ f"
- x "\"Header\r"
- x "(sqrt 1\r\ 2"
- x "pses-center\r\ 6"
- x "\t"
- x "\10(+ A2 A3\r"
- x "\ 6(* B2 A3\r"
- x "\152\ 3\e\b"
- x "\r\7f\7f\7fB3\r"
- x "\18\13"
- x))
- ;;Basic cell display
- (fset 'ses-exercise-display
- (concat y "\e:(revert-buffer t t)\r"
- x "\ 5"
- x "\"Very long\r\ 2"
- x "w3\r"
- x "w3\r"
- x "(/ 1 0\r\ 2"
- x "234567\r\ 2"
- x "\155w"
- x "\t1\r\ 2"
- x "\ 2\ 3\ 3"
- x "\ 6234567\r\ 2"
- x "\t\ 4\ 2"
- x "\ 2\ 3\ 3"
- x "345678\r\ 2"
- x "\153w"
- x "\0\e>"
- x "\ 3\ 3"
- x "\18\18"
- x "\ 5"
- x "\18\18\ 1"
- x "\ 5"
- x "\ 6\ 5"
- x "\ 3\ 3"
- x "1\r\ 2"
- x "\ 3\ 3\ 6"
- x "\ 5"
- x "\ 2\ 2\ 2\"1234567-1234567-1234567\r\ 2"
- x "123\r\ 2"
- x "\152\ f"
- x "\ e\"1234567-1234567-1234567\r\ 2"
- x "123\r\ 2"
- x "\ 6\ 6w8\r"
- x "\ 2\ 2\"1234567\r"
- x "\ e\ 2w5\r"
- x))
- ;;Cell formulas
- (fset 'ses-exercise-formulas
- (concat y "\e:(revert-buffer t t)\r"
- x "\t\t"
- x "\t"
- x "(* B1 B2 D1\r\ 2"
- x "(* B2 B3\r\ 2"
- x "\ e(apply '+ (ses-range B1 B3)\r\ 2"
- x "(apply 'ses+ (ses-range B1 B3)\r\ 2"
- x "\ e(apply 'ses+ (ses-range A2 A3)\r\ 2"
- x "\ e(mapconcat'number-to-string(ses-range B2 B4) \"-\"\r\ 2"
- x "\ 2(apply 'concat (reverse (ses-range A3 D3))\r\ 2"
- x "\ 2(* (+ A2 A3) (ses+ B2 B3)\r\ 2"
- x "\ e"
- x "\152\ f"
- x "\155\t"
- x "\10(apply 'ses+ (ses-range E1 E2)\r\ 2"
- x "\10(apply 'ses+ (ses-range A5 B5)\r\ 2"
- x "\10(apply 'ses+ (ses-range E1 F1)\r\ 2"
- x "\10(apply 'ses+ (ses-range D1 E1)\r\ 2"
- x "\t"
- x "(ses-average (ses-range A2 A5)\r\ 2"
- x "\ e(apply 'ses+ (ses-range A5 A6)\r\ 2"
- x "\ 2\ 2\ek"
- x "\ e\ e\v"
- x "\10\10\10\ f"
- x "\ e\152\ f"
- x "\10\153\v"
- x "\ 2\ 2\ 2\eo"
- x "\ 6\152\eo"
- x "\ 2\153\ek"
- x "\ 6(ses-average (ses-range B3 E3)\r\ 2"
- x "\ 2\ek"
- x "\ e\1012345678\r\ 2"
- x))
- ;;Recalculating and reconstructing
- (fset 'ses-exercise-recalc
- (concat y "\e:(revert-buffer t t)\r"
- x "\ 3\e\f"
- x "\t\t"
- x "\ 3\ 3"
- x "(/ 1 0\r\ 2"
- x "\ 3\ 3"
- x "\n"
- x "\ 3\ 3"
- x "\ 3\10\"%.6g\"\r"
- x "\ 3\e\f"
- x "\e>\18nw\ 6\ 6\ 6"
- x "\0\e>\exdelete-region\r"
- x "\ 3\e\f"
- x "\158\ e"
- x "\0\e>\exdelete-region\r"
- x "\ 3\e\f"
- x "\ 3\ e"
- x "\ e\v\ 2\ek"
- x "\ 3\f"
- x "\ 2\"Very long\r"
- x "\10\ 3\14"
- x "\ 2\r\r"
- x "\ e\ 3\14"
- x "\ 6\eo"
- x "\ 6\ 3\14"
- x "\ 2\ 2\"Very long2\r"
- x "\ 2\eo\ 6"
- x "\ 3\14"
- x "\r\7f\7f\7fC3\r"
- x "\ e\r\7f\7f\7fC2\r"
- x "\10\0\ e\ 6\ 3\ 3"
- x "\r\7f\7fC4\r"
- x "\ e\ e\r\7f\7f\7fC2\r"
- x "\ 6\0\ 2\10\10"
- x "\ 3\ 3"
- x "\exses-mode\r"
- x "\e<\ f"
- x "\152\ek"
- x))
- ;;Header line
- (fset 'ses-exercise-header-row
- (concat y "\e:(revert-buffer t t)\r"
- x "\18<"
- x "\18>"
- x "\156\18<"
- x "\18>"
- x "\157\18<"
- x "\18>"
- x "\158\18<"
- x "\152\18<"
- x "\18>"
- x "\ 6\153w\ 2"
- x "\1510\18<"
- x "\18>"
- x "\152\v"
- x))
- ;;Detecting unsafe formulas and printers
- (fset 'ses-exercise-unsafe
- (concat y "\e:(revert-buffer t t)\r"
- x "p(lambda (x) (delete-file x))\rn"
- x "p(lambda (x) (delete-file \"ses-nothing\"))\ry"
- x "\0\ 6\17\19n"
- x "\ e(delete-file \"x\"\rn"
- x "(delete-file \"ses-nothing\"\ry\ 2"
- x "\0\ 6\17\19n"
- x "(open-network-stream \"x\" nil \"localhost\" \"smtp\"\ry\ 2"
- x "\0\ 6\17\19n"
- x))
- ;;Inserting and deleting rows
- (fset 'ses-exercise-rows
- (concat y "\e:(revert-buffer t t)\r"
- x "\ e\ 6"
- x "\ 3\10\"%s=\"\r"
- x "\1520\ f"
- x "\ep\"%s+\"\r"
- x "\ e\ f"
- x "123456789\r\ 2"
- x "\0\1521\ e\ 6"
- x "\ 3\ 3"
- x "\e\f"
- x "\10\10(not B25\r\ 2"
- x "\ e\ek"
- x "jA3\r"
- x "\1519\v"
- x "\10\ 6\v"
- x "\15100\ f" ;Make this approx your CPU speed in MHz
- x))
- ;;Inserting and deleting columns
- (fset 'ses-exercise-columns
- (concat y "\e:(revert-buffer t t)\r"
- x "\ 3\10\"%s@\"\r"
- x "\eo"
- x "\ f"
- x "\eo"
- x "\v"
- x "\ek"
- x "w8\r"
- x "\ep\"%.7s*\"\r"
- x "\eo"
- x "\ 6"
- x "\152\eo"
- x "\153\ek"
- x "\ 3\10\"%.6g\"\r"
- x "\1526\eo"
- x "\0\1526\t"
- x "\1526\eo"
- x "\ 3\e\b0\r"
- x "\1526\t"
- x "\15400\ 2"
- x "\1550\ek"
- x "\0\ e\ e\ 6\ 6\ 3\e\13D"
- x))
- (fset 'ses-exercise-editing
- (concat y "\e:(revert-buffer t t)\r"
- x "\ e\ e\ e1\r\ 2"
- x "\ 6(\ 2'\ 6x\r\ 2"
- x "\ 2\10\10\10\ f"
- x "\1f"
- x "\r\r"
- x "w9\r"
- x "\ e\r\ 2.5\r"
- x "\ e\ 6\r\ 2 10\r"
- x "w12\r"
- x "\r\ 1'\r"
- x "\r\ 1\ 4\r"
- x "jA4\r"
- x "(+ A2 100\r\ 2"
- x "\10\103\r\ 2"
- x "jB1\r"
- x "(not A1\r\ 2"
- x "\ 2\"Very long\r\ 2"
- x "\ 3\ 3"
- x "\eh"
- x "\eH"
- x "\ 3\ 3"
- x "\e>\t"
- x "\10\10\ 4"
- x "\10\ 4"
- x "\ 6\ 6\152\7f"
- x "\10\7f"
- x "\eo"
- x "\eh"
- x "\0\ f\ 6"
- x "\"Also very long\r\ 2"
- x "\ e\ 6\eH"
- x "\0'\r\ 2"
- x "'Trial\r\ 2"
- x "\ e\ 2'qwerty\r\ 2"
- x "\ 6(concat \18o\e<\0\ e\ e"
- x "\15-1\18o\ 3\12\r\ 2"
- x "(apply '+ \18o\e<\0\ e\ 6\15-1\18o\ 3\13\r\ 2"
- x "\10\152\7f"
- x "\15-2\7f"
- x "\15-2\ 4"
- x "\152\ 4"
- x "\ 2\10\10\v"
- x "\ e\ 6\eH"
- x "\ 2\10\0\ f"
- x "\"Another long one\r\ 2"
- x "\ e\ e\ 6\eH"
- x "\ 1\10\ 5"
- x "\ 3\ 3\e<"
- x "\ e\ 5"
- x "\e>\10\ f"
- x "\0\ 5\ 6\ 5"
- x))
- ;;Sorting of columns
- (fset 'ses-exercise-sort-column
- (concat y "\e:(revert-buffer t t)\r"
- x "\"Very long\r"
- x "\ 699\r"
- x "\ 6\eo13\r"
- x "(+ A3 B3\r"
- x "7\r8\r(* A4 B4\r"
- x "\0\10\10\10\ 3\e\13A\r"
- x "\ e\0\10\10\10\ 3\e\13B\r"
- x "\10\10\ 6\0\ e\ e\ 6\ 6\ 3\e\13C\r"
- x "\ 6\eo\10\ f"
- x "\ 2\0\ e\ e\ e\15\ 3\e\13C\r"
- x))
- ;;Simple cell printers
- (fset 'ses-exercise-cell-printers
- (concat y "\e:(revert-buffer t t)\r"
- x "\ 6\"4\11\t76\r\ 2"
- x "\"4\11\n7\r\ 2"
- x "p\"{%S}\"\r"
- x "p(\"[%s]\")\r"
- x "p(\"<%s>\")\r"
- x "\ 2\0\ 6\ 6"
- x "p\r"
- x "pnil\r"
- x "pses-dashfill\r"
- x "48\r\ 2"
- x "\t"
- x "\ 2\0\ 6p\r"
- x "\ 6p\r"
- x "pses-dashfill\r"
- x "\ 2\0\ 6\ 6pnil\r"
- x "5\r\ 2"
- x "pses-center\r"
- x "\ 3\10\"%s\"\r"
- x "w8\r"
- x "\ep\r"
- x "\ep\"%.7g@\"\r"
- x "\ 3\10\r"
- x "\ 3\10\"%.6g#\"\r"
- x "\ 3\10\"%.6g.\"\r"
- x "\ 3\10\"%.6g.\"\r"
- x "\epidentity\r"
- x "6\r\ 2"
- x "\ e\"UPCASE\r\ 2"
- x "\epdowncase\r"
- x "(* 3 4\r\ 2"
- x "p(lambda\11 (x)\11 '(\"Hi\"))\r"
- x "p(lambda\11 (x)\11 '(\"Bye\"))\r"
- x))
- ;;Spanning cell printers
- (fset 'ses-exercise-spanning-printers
- (concat y "\e:(revert-buffer t t)\r"
- x "\ep\"%.6g*\"\r"
- x "pses-dashfill-span\r"
- x "5\r\ 2"
- x "pses-tildefill-span\r"
- x "\"4\r\ 2"
- x "\ep\"$%s\"\r"
- x "\ep(\"$%s\")\r"
- x "8\r\ 2"
- x "\ep(\"!%s!\")\r"
- x "\t\"12345678\r\ 2"
- x "pses-dashfill-span\r"
- x "\"23456789\r\ 2"
- x "\t"
- x "(not t\r\ 2"
- x "\ 2w6\r"
- x "\"5\r\ 2"
- x "\ e\ 6\eo"
- x "\ek"
- x "\ek"
- x "\t"
- x "\ 2\10\ 3\ 3"
- x "\eo"
- x "\ e\152\ek"
- x "\ 2\ 2\ek"
- x))
- ;;Cut/copy/paste - within same buffer
- (fset 'ses-exercise-paste-1buf
- (concat y "\e:(revert-buffer t t)\r"
- x "\ e\0\ 6\ew"
- x "\ 3\ 3\10\ 6\19"
- x "\ e\eo"
- x "\"middle\r\ 2"
- x "\0\ 6\ e\ 6"
- x "\ew"
- x "\10\0\ 6"
- x "\ew"
- x "\ 3\ 3\ 6\ e"
- x "\19"
- x "\152\19y"
- x "\ 6\15\19y"
- x "\10\10\ 6\15\19y"
- x "\e>"
- x "\19y"
- x "\e>\19y"
- x "\e<"
- x "p\"<%s>\"\r"
- x "\ 6pses-dashfill\r"
- x "\ 2\0\ 6\ 6\ 6\ e\ e\ e"
- x "\17"
- x "\1f"
- x "\15\19y"
- x "\r\0\ 2\ 2\ 2\ew"
- x "\r\ 6\19"
- x "\153\10(+ G2 H1\r"
- x "\0\ 2\ew"
- x "\ 3\ 3\e>\ 2"
- x "\19"
- x "\ 2\158\10(ses-average (ses-range G2 H2)\r\ 2"
- x "\0\ 6\17\ek"
- x "\157\ e"
- x "\19"
- x "\10\ 2(ses-average (ses-range E7 E9)\r\ 2"
- x "\0\ 6\17\v"
- x "\ e\19"
- x "\ 2\ 2\10(ses-average (ses-range E7 F7)\r\ 2"
- x "\0\ 6\17\ek"
- x "\ 6\19"
- x "\ 2\ 2\10(ses-average (ses-range D6 E6)\r\ 2"
- x "\0\ 6\17\ek"
- x "\ 6\19"
- x "\ 1\152\ f"
- x "\"Line A\r\ 2"
- x "pses-tildefill-span\r"
- x "\ e\ 6\"Subline A(1)\r\ 2"
- x "pses-dashfill-span\r"
- x "\ 2\10\0\ e\ e\ e\ew\ 3\ 3"
- x "\ 1\10\10\10\10\10\10"
- x "\19"
- x "\0\ e\ 6\ 6\ew\ 3\ 3"
- x "\ 6\19"
- x))
- ;;Cut/copy/paste - between two buffers
- (fset 'ses-exercise-paste-2buf
- (concat y "\e:(revert-buffer t t)\r"
- x "\ 6\ e\eo\"middle\r\ 2\0\ 6\ e\ 6"
- x "\17"
- x "\184bses-test.txt\r"
- x " \ 1\19"
- x "\ 5\"xxx\0\ 2\ 2\ 2\ 2"
- x "\ew\18o"
- x "\1f"
- x "\19"
- x "\18o\ 5\"\0\ 2\ 2\ 2\ 2\ 2"
- x "\ew\18o\19"
- x "\18o123.45\0\ 2\ 2\ 2\ 2\ 2\ 2"
- x "\17\18o\19"
- x "\18o1 \ 2\ 2\0\ 6\ 6\ 6\ 6\ 6\ 6\ 6"
- x "\17\18o\19"
- x "\e>\19y"
- x "\ 6\18o symb\0\ 2\ 2\ 2\ 2"
- x "\17\18o\15\19\ey\152\ey"
- x "\18o1\t\0\ 2\ 2"
- x "\17\18o\ 2\19"
- x "w9\n\ep\"<%s>\"\n"
- x "\18o\n2\t\"3\nxxx\t5\n\0\10\10"
- x "\17\18o\19y"
- x))
- ;;Export text, import it back
- (fset 'ses-exercise-import-export
- (concat y "\e:(revert-buffer t t)\r"
- x "\ e\ e\ 6\0\ 6xt"
- x "\184bses-test.txt\r"
- x "\n\19\15-1\18o"
- x "xT\18o\19\15-1\18o"
- x "\ 3\ 3\ 6'crunch\r\ 2"
- x "\10\10\10pses-center-span\r"
- x "\0\ e\ e\ e\ exT"
- x "\18o\n\19\15-1\18o"
- x "\0\19y"
- x "\ 6\0\ 2\10\10xt"
- x "\ e\ e\0\15\19y"
- x "12345678\r\ 2"
- x "\ 6\ 6'bunch\r"
- x "\0\10\10xtxT"
- x)))
-
-(defun ses-exercise-macros ()
- "Executes all SES coverage-test macros."
- (dolist (x '(ses-exercise-example
- ses-exercise-new
- ses-exercise-display
- ses-exercise-formulas
- ses-exercise-recalc
- ses-exercise-header-row
- ses-exercise-unsafe
- ses-exercise-rows
- ses-exercise-columns
- ses-exercise-editing
- ses-exercise-sort-column
- ses-exercise-cell-printers
- ses-exercise-spanning-printers
- ses-exercise-paste-1buf
- ses-exercise-paste-2buf
- ses-exercise-import-export))
- (message "<Testing %s>" x)
- (execute-kbd-macro x)))
-
-(defun ses-exercise-signals ()
- "Exercise code paths that lead to error signals, other than those for
-spreadsheet files with invalid formatting."
- (message "<Checking for expected errors>")
- (switch-to-buffer "ses-test.ses")
- (deactivate-mark)
- (ses-jump 'A1)
- (ses-set-curcell)
- (dolist (x '((ses-column-widths 14)
- (ses-column-printers "%s")
- (ses-column-printers ["%s" "%s" "%s"]) ;Should be two
- (ses-column-widths [14])
- (ses-delete-column -99)
- (ses-delete-column 2)
- (ses-delete-row -1)
- (ses-goto-data 'hogwash)
- (ses-header-row -56)
- (ses-header-row 99)
- (ses-insert-column -14)
- (ses-insert-row 0)
- (ses-jump 'B8) ;Covered by preceding cell
- (ses-printer-validate '("%s" t))
- (ses-printer-validate '([47]))
- (ses-read-header-row -1)
- (ses-read-header-row 32767)
- (ses-relocate-all 0 0 -1 1)
- (ses-relocate-all 0 0 1 -1)
- (ses-select (ses-range A1 A2) 'x (ses-range B1 B1))
- (ses-set-cell 0 0 'hogwash nil)
- (ses-set-column-width 0 0)
- (ses-yank-cells #("a\nb"
- 0 1 (ses (A1 nil nil))
- 2 3 (ses (A3 nil nil)))
- nil)
- (ses-yank-cells #("ab"
- 0 1 (ses (A1 nil nil))
- 1 2 (ses (A2 nil nil)))
- nil)
- (ses-yank-pop nil)
- (ses-yank-tsf "1\t2\n3" nil)
- (let ((curcell nil)) (ses-check-curcell))
- (let ((curcell 'A1)) (ses-check-curcell 'needrange))
- (let ((curcell '(A1 . A2))) (ses-check-curcell 'end))
- (let ((curcell '(A1 . A2))) (ses-sort-column "B"))
- (let ((curcell '(C1 . D2))) (ses-sort-column "B"))
- (execute-kbd-macro "jB10\n\152\ 4")
- (execute-kbd-macro [?j ?B ?9 ?\n ?\C-@ ?\C-f ?\C-f cut])
- (progn (kill-new "x") (execute-kbd-macro "\e>\19n"))
- (execute-kbd-macro "\ 2\0\ew")))
- (condition-case nil
- (progn
- (eval x)
- (signal 'singularity-error nil)) ;Shouldn't get here
- (singularity-error (error "No error from %s?" x))
- (error nil)))
- ;;Test quit-handling in ses-update-cells. Cant' use `eval' here.
- (let ((inhibit-quit t))
- (setq quit-flag t)
- (condition-case nil
- (progn
- (ses-update-cells '(A1))
- (signal 'singularity-error nil))
- (singularity-error (error "Quit failure in ses-update-cells"))
- (error nil))
- (setq quit-flag nil)))
-
-(defun ses-exercise-invalid-spreadsheets ()
- "Execute code paths that detect invalid spreadsheet files."
- ;;Detect invalid spreadsheets
- (let ((p&d "\n\n\f\n(ses-cell A1 nil nil nil nil)\n\n")
- (cw "(ses-column-widths [7])\n")
- (cp "(ses-column-printers [ses-center])\n")
- (dp "(ses-default-printer \"%.7g\")\n")
- (hr "(ses-header-row 0)\n")
- (p11 "(2 1 1)")
- (igp ses-initial-global-parameters))
- (dolist (x (list "(1)"
- "(x 2 3)"
- "(1 x 3)"
- "(1 -1 0)"
- "(1 2 x)"
- "(1 2 -1)"
- "(3 1 1)"
- "\n\n\f(2 1 1)"
- "\n\n\f\n(ses-cell)(2 1 1)"
- "\n\n\f\n(x)\n(2 1 1)"
- "\n\n\n\f\n(ses-cell A2)\n(2 2 2)"
- "\n\n\n\f\n(ses-cell B1)\n(2 2 2)"
- "\n\n\f\n(ses-cell A1 nil nil nil nil)\n(2 1 1)"
- (concat p&d "(x)\n(x)\n(x)\n(x)\n" p11)
- (concat p&d "(ses-column-widths)(x)\n(x)\n(x)\n" p11)
- (concat p&d cw "(x)\n(x)\n(x)\n(2 1 1)")
- (concat p&d cw "(ses-column-printers)(x)\n(x)\n" p11)
- (concat p&d cw cp "(x)\n(x)\n" p11)
- (concat p&d cw cp "(ses-default-printer)(x)\n" p11)
- (concat p&d cw cp dp "(x)\n" p11)
- (concat p&d cw cp dp "(ses-header-row)" p11)
- (concat p&d cw cp dp hr p11)
- (concat p&d cw cp dp "\n" hr igp)))
- (condition-case nil
- (with-temp-buffer
- (insert x)
- (ses-load)
- (signal 'singularity-error nil)) ;Shouldn't get here
- (singularity-error (error "%S is an invalid spreadsheet!" x))
- (error nil)))))
-
-(defun ses-exercise-startup ()
- "Prepare for coverage tests"
- ;;Clean up from any previous runs
- (condition-case nil (kill-buffer "ses-example.ses") (error nil))
- (condition-case nil (kill-buffer "ses-test.ses") (error nil))
- (condition-case nil (delete-file "ses-test.ses") (file-error nil))
- (delete-other-windows) ;Needed for "\C-xo" in ses-exercise-editing
- (setq ses-mode-map nil) ;Force rebuild
- (testcover-unmark-all "ses.el")
- ;;Enable
- (let ((testcover-1value-functions
- ;;forward-line always returns 0, for us.
- ;;remove-text-properties always returns t for us.
- ;;ses-recalculate-cell returns the same " " any time curcell is a cons
- ;;Macros ses-dorange and ses-dotimes-msg generate code that always
- ;; returns nil
- (append '(forward-line remove-text-properties ses-recalculate-cell
- ses-dorange ses-dotimes-msg)
- testcover-1value-functions))
- (testcover-constants
- ;;These maps get initialized, then never changed again
- (append '(ses-mode-map ses-mode-print-map ses-mode-edit-map)
- testcover-constants)))
- (testcover-start "ses.el" t))
- (require 'unsafep)) ;In case user has safe-functions = t!
-
-
-;;;#########################################################################
-(defun ses-exercise ()
- "Executes all SES coverage tests and displays the results."
- (interactive)
- (ses-exercise-startup)
- ;;Run the keyboard-macro tests
- (let ((safe-functions nil)
- (ses-initial-size '(1 . 1))
- (ses-initial-column-width 7)
- (ses-initial-default-printer "%.7g")
- (ses-after-entry-functions '(forward-char))
- (ses-mode-hook nil))
- (ses-exercise-macros)
- (ses-exercise-signals)
- (ses-exercise-invalid-spreadsheets)
- ;;Upgrade of old-style spreadsheet
- (with-temp-buffer
- (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")
- (ses-load))
- ;;ses-vector-delete is always called from buffer-undo-list with the same
- ;;symbol as argument. We'll give it a different one here.
- (let ((x [1 2 3]))
- (ses-vector-delete 'x 0 0))
- ;;ses-create-header-string behaves differently in a non-window environment
- ;;but we always test under windows.
- (let ((window-system (not window-system)))
- (scroll-left 7)
- (ses-create-header-string))
- ;;Test for nonstandard after-entry functions
- (let ((ses-after-entry-functions '(forward-line))
- ses-mode-hook)
- (ses-read-cell 0 0 1)
- (ses-read-symbol 0 0 t)))
- ;;Tests with unsafep disabled
- (let ((safe-functions t)
- ses-mode-hook)
- (message "<Checking safe-functions = t>")
- (kill-buffer "ses-example.ses")
- (find-file "ses-example.ses"))
- ;;Checks for nonstandard default values for new spreadsheets
- (let (ses-mode-hook)
- (dolist (x '(("%.6g" 8 (2 . 2))
- ("%.8g" 6 (3 . 3))))
- (let ((ses-initial-size (nth 2 x))
- (ses-initial-column-width (nth 1 x))
- (ses-initial-default-printer (nth 0 x)))
- (with-temp-buffer
- (set-buffer-modified-p t)
- (ses-mode)))))
- ;;Test error-handling in command hook, outside a macro.
- ;;This will ring the bell.
- (let (curcell-overlay)
- (ses-command-hook))
- ;;Due to use of run-with-timer, ses-command-hook sometimes gets called
- ;;after we switch to another buffer.
- (switch-to-buffer "*scratch*")
- (ses-command-hook)
- ;;Print results
- (message "<Marking source code>")
- (testcover-mark-all "ses.el")
- (testcover-next-mark)
- ;;Cleanup
- (delete-other-windows)
- (kill-buffer "ses-test.txt")
- ;;Could do this here: (testcover-end "ses.el")
- (message "Done"))
-
-;;; arch-tag: 87052ba4-5cf8-46cf-9375-fe245f3360b8
-;; testcover-ses.el ends here.
+++ /dev/null
-;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
-
-;; Copyright (C) 2002 Free Software Foundation, Inc.
-
-;; Author: Jonathan Yavner <jyavner@engineer.com>
-;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
-;; Keywords: safety lisp utility
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-(require 'testcover)
-
-;;;These forms are all considered safe
-(defconst testcover-unsafep-safe
- '(((lambda (x) (* x 2)) 14)
- (apply 'cdr (mapcar '(lambda (x) (car x)) y))
- (cond ((= x 4) 5) (t 27))
- (condition-case x (car y) (error (car x)))
- (dolist (x y) (message "here: %s" x))
- (dotimes (x 14 (* x 2)) (message "here: %d" x))
- (let (x) (dolist (y '(1 2 3) (1+ y)) (push y x)))
- (let (x) (apply '(lambda (x) (* x 2)) 14))
- (let ((x '(2))) (push 1 x) (pop x) (add-to-list 'x 2))
- (let ((x 1) (y 2)) (setq x (+ x y)))
- (let ((x 1)) (let ((y (+ x 3))) (* x y)))
- (let* nil (current-time))
- (let* ((x 1) (y (+ x 3))) (* x y))
- (mapcar (lambda (x &optional y &rest z) (setq y (+ x 2)) (* y 3)) '(1 2 3))
- (mapconcat #'(lambda (var) (propertize var 'face 'bold)) '("1" "2") ", ")
- (setq buffer-display-count 14 mark-active t)
- ;;This is not safe if you insert it into a buffer!
- (propertize "x" 'display '(height (progn (delete-file "x") 1))))
- "List of forms that `unsafep' should decide are safe.")
-
-;;;These forms are considered unsafe
-(defconst testcover-unsafep-unsafe
- '(( (add-to-list x y)
- . (unquoted x))
- ( (add-to-list y x)
- . (unquoted y))
- ( (add-to-list 'y x)
- . (global-variable y))
- ( (not (delete-file "unsafep.el"))
- . (function delete-file))
- ( (cond (t (aset local-abbrev-table 0 0)))
- . (function aset))
- ( (cond (t (setq unsafep-vars "")))
- . (risky-local-variable unsafep-vars))
- ( (condition-case format-alist 1)
- . (risky-local-variable format-alist))
- ( (condition-case x 1 (error (setq format-alist "")))
- . (risky-local-variable format-alist))
- ( (dolist (x (sort globalvar 'car)) (princ x))
- . (function sort))
- ( (dotimes (x 14) (delete-file "x"))
- . (function delete-file))
- ( (let ((post-command-hook "/tmp/")) 1)
- . (risky-local-variable post-command-hook))
- ( (let ((x (delete-file "x"))) 2)
- . (function delete-file))
- ( (let (x) (add-to-list 'x (delete-file "x")))
- . (function delete-file))
- ( (let (x) (condition-case y (setq x 1 z 2)))
- . (global-variable z))
- ( (let (x) (condition-case z 1 (error (delete-file "x"))))
- . (function delete-file))
- ( (let (x) (mapc (lambda (x) (setcar x 1)) '((1 . 2) (3 . 4))))
- . (function setcar))
- ( (let (y) (push (delete-file "x") y))
- . (function delete-file))
- ( (let* ((x 1)) (setq y 14))
- . (global-variable y))
- ( (mapc 'car (list '(1 . 2) (cons 3 4) (kill-buffer "unsafep.el")))
- . (function kill-buffer))
- ( (mapcar x y)
- . (unquoted x))
- ( (mapcar '(lambda (x) (rename-file x "x")) '("unsafep.el"))
- . (function rename-file))
- ( (mapconcat x1 x2 " ")
- . (unquoted x1))
- ( (pop format-alist)
- . (risky-local-variable format-alist))
- ( (push 1 format-alist)
- . (risky-local-variable format-alist))
- ( (setq buffer-display-count (delete-file "x"))
- . (function delete-file))
- ;;These are actualy safe (they signal errors)
- ( (apply '(x) '(1 2 3))
- . (function (x)))
- ( (let (((x))) 1)
- . (variable (x)))
- ( (let (1) 2)
- . (variable 1))
- )
- "A-list of (FORM . REASON)... that`unsafep' should decide are unsafe.")
-
-
-;;;#########################################################################
-(defun testcover-unsafep ()
- "Executes all unsafep tests and displays the coverage results."
- (interactive)
- (testcover-unmark-all "unsafep.el")
- (testcover-start "unsafep.el")
- (let (save-functions)
- (dolist (x testcover-unsafep-safe)
- (if (unsafep x)
- (error "%S should be safe" x)))
- (dolist (x testcover-unsafep-unsafe)
- (if (not (equal (unsafep (car x)) (cdr x)))
- (error "%S should be unsafe: %s" (car x) (cdr x))))
- (setq safe-functions t)
- (if (or (unsafep '(delete-file "x"))
- (unsafep-function 'delete-file))
- (error "safe-functions=t should allow delete-file"))
- (setq safe-functions '(setcar))
- (if (unsafep '(setcar x 1))
- (error "safe-functions=(setcar) should allow setcar"))
- (if (not (unsafep '(setcdr x 1)))
- (error "safe-functions=(setcar) should not allow setcdr")))
- (testcover-mark-all "unsafep.el")
- (testcover-end "unsafep.el")
- (message "Done"))
-
-;;; arch-tag: a7616c27-1998-47ae-9304-76d1439dbf29
-;; testcover-unsafep.el ends here.
projects / emacs.git / commitdiff