1;;;; testcover-ses.el -- Example use of `testcover' to test "SES" 2 3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 4 5;; Author: Jonathan Yavner <jyavner@engineer.com> 6;; Maintainer: Jonathan Yavner <jyavner@engineer.com> 7;; Keywords: spreadsheet lisp utility 8 9;; GNU Emacs is free software; you can redistribute it and/or modify 10;; it under the terms of the GNU General Public License as published by 11;; the Free Software Foundation; either version 2, or (at your option) 12;; any later version. 13 14;; GNU Emacs is distributed in the hope that it will be useful, 15;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17;; GNU General Public License for more details. 18 19;; You should have received a copy of the GNU General Public License 20;; along with GNU Emacs; see the file COPYING. If not, write to the 21;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 22;; Boston, MA 02110-1301, USA. 23 24(require 'testcover) 25 26(defvar ses-initial-global-parameters) 27(defvar ses-mode-map) 28 29;;;Here are some macros that exercise SES. Set `pause' to t if you want the 30;;;macros to pause after each step. 31(let* ((pause nil) 32 (x (if pause "q" "")) 33 (y "ses-test.ses\r<")) 34 ;;Fiddle with the existing spreadsheet 35 (fset 'ses-exercise-example 36 (concat "" data-directory "ses-example.ses\r<" 37 x "10" 38 x "" 39 x "" 40 x "pses-center\r" 41 x "p\r" 42 x "\t\t" 43 x "\r A9 B9\r" 44 x "" 45 x "\r2\r" 46 x "" 47 x "50\r" 48 x "4" 49 x " " 50 x "" 51 x "(+ o\0" 52 x "-1o \r" 53 x "" 54 x)) 55 ;;Create a new spreadsheet 56 (fset 'ses-exercise-new 57 (concat y 58 x "\"%.8g\"\r" 59 x "2\r" 60 x "" 61 x "" 62 x "2" 63 x "\"Header\r" 64 x "(sqrt 1\r" 65 x "pses-center\r" 66 x "\t" 67 x "(+ A2 A3\r" 68 x "(* B2 A3\r" 69 x "2" 70 x "\rB3\r" 71 x "" 72 x)) 73 ;;Basic cell display 74 (fset 'ses-exercise-display 75 (concat y ":(revert-buffer t t)\r" 76 x "" 77 x "\"Very long\r" 78 x "w3\r" 79 x "w3\r" 80 x "(/ 1 0\r" 81 x "234567\r" 82 x "5w" 83 x "\t1\r" 84 x "" 85 x "234567\r" 86 x "\t" 87 x "" 88 x "345678\r" 89 x "3w" 90 x "\0>" 91 x "" 92 x "" 93 x "" 94 x "" 95 x "" 96 x "" 97 x "" 98 x "1\r" 99 x "" 100 x "" 101 x "\"1234567-1234567-1234567\r" 102 x "123\r" 103 x "2" 104 x "\"1234567-1234567-1234567\r" 105 x "123\r" 106 x "w8\r" 107 x "\"1234567\r" 108 x "w5\r" 109 x)) 110 ;;Cell formulas 111 (fset 'ses-exercise-formulas 112 (concat y ":(revert-buffer t t)\r" 113 x "\t\t" 114 x "\t" 115 x "(* B1 B2 D1\r" 116 x "(* B2 B3\r" 117 x "(apply '+ (ses-range B1 B3)\r" 118 x "(apply 'ses+ (ses-range B1 B3)\r" 119 x "(apply 'ses+ (ses-range A2 A3)\r" 120 x "(mapconcat'number-to-string(ses-range B2 B4) \"-\"\r" 121 x "(apply 'concat (reverse (ses-range A3 D3))\r" 122 x "(* (+ A2 A3) (ses+ B2 B3)\r" 123 x "" 124 x "2" 125 x "5\t" 126 x "(apply 'ses+ (ses-range E1 E2)\r" 127 x "(apply 'ses+ (ses-range A5 B5)\r" 128 x "(apply 'ses+ (ses-range E1 F1)\r" 129 x "(apply 'ses+ (ses-range D1 E1)\r" 130 x "\t" 131 x "(ses-average (ses-range A2 A5)\r" 132 x "(apply 'ses+ (ses-range A5 A6)\r" 133 x "k" 134 x "" 135 x "" 136 x "2" 137 x "3" 138 x "o" 139 x "2o" 140 x "3k" 141 x "(ses-average (ses-range B3 E3)\r" 142 x "k" 143 x "12345678\r" 144 x)) 145 ;;Recalculating and reconstructing 146 (fset 'ses-exercise-recalc 147 (concat y ":(revert-buffer t t)\r" 148 x " " 149 x "\t\t" 150 x "" 151 x "(/ 1 0\r" 152 x "" 153 x "\n" 154 x "" 155 x "\"%.6g\"\r" 156 x " " 157 x ">nw" 158 x "\0>xdelete-region\r" 159 x " " 160 x "8" 161 x "\0>xdelete-region\r" 162 x " " 163 x "" 164 x "k" 165 x " " 166 x "\"Very long\r" 167 x "" 168 x "\r\r" 169 x "" 170 x "o" 171 x "" 172 x "\"Very long2\r" 173 x "o" 174 x "" 175 x "\rC3\r" 176 x "\rC2\r" 177 x "\0" 178 x "\rC4\r" 179 x "\rC2\r" 180 x "\0" 181 x "" 182 x "xses-mode\r" 183 x "<" 184 x "2k" 185 x)) 186 ;;Header line 187 (fset 'ses-exercise-header-row 188 (concat y ":(revert-buffer t t)\r" 189 x "<" 190 x ">" 191 x "6<" 192 x ">" 193 x "7<" 194 x ">" 195 x "8<" 196 x "2<" 197 x ">" 198 x "3w" 199 x "10<" 200 x ">" 201 x "2" 202 x)) 203 ;;Detecting unsafe formulas and printers 204 (fset 'ses-exercise-unsafe 205 (concat y ":(revert-buffer t t)\r" 206 x "p(lambda (x) (delete-file x))\rn" 207 x "p(lambda (x) (delete-file \"ses-nothing\"))\ry" 208 x "\0n" 209 x "(delete-file \"x\"\rn" 210 x "(delete-file \"ses-nothing\"\ry" 211 x "\0n" 212 x "(open-network-stream \"x\" nil \"localhost\" \"smtp\"\ry" 213 x "\0n" 214 x)) 215 ;;Inserting and deleting rows 216 (fset 'ses-exercise-rows 217 (concat y ":(revert-buffer t t)\r" 218 x "" 219 x "\"%s=\"\r" 220 x "20" 221 x "p\"%s+\"\r" 222 x "" 223 x "123456789\r" 224 x "\021" 225 x "" 226 x " " 227 x "(not B25\r" 228 x "k" 229 x "jA3\r" 230 x "19" 231 x "" 232 x "100" ;Make this approx your CPU speed in MHz 233 x)) 234 ;;Inserting and deleting columns 235 (fset 'ses-exercise-columns 236 (concat y ":(revert-buffer t t)\r" 237 x "\"%s@\"\r" 238 x "o" 239 x "" 240 x "o" 241 x "" 242 x "k" 243 x "w8\r" 244 x "p\"%.7s*\"\r" 245 x "o" 246 x "" 247 x "2o" 248 x "3k" 249 x "\"%.6g\"\r" 250 x "26o" 251 x "\026\t" 252 x "26o" 253 x "0\r" 254 x "26\t" 255 x "400" 256 x "50k" 257 x "\0D" 258 x)) 259 (fset 'ses-exercise-editing 260 (concat y ":(revert-buffer t t)\r" 261 x "1\r" 262 x "('x\r" 263 x "" 264 x "" 265 x "\r\r" 266 x "w9\r" 267 x "\r.5\r" 268 x "\r 10\r" 269 x "w12\r" 270 x "\r'\r" 271 x "\r\r" 272 x "jA4\r" 273 x "(+ A2 100\r" 274 x "3\r" 275 x "jB1\r" 276 x "(not A1\r" 277 x "\"Very long\r" 278 x "" 279 x "h" 280 x "H" 281 x "" 282 x ">\t" 283 x "" 284 x "" 285 x "2" 286 x "" 287 x "o" 288 x "h" 289 x "\0" 290 x "\"Also very long\r" 291 x "H" 292 x "\0'\r" 293 x "'Trial\r" 294 x "'qwerty\r" 295 x "(concat o<\0" 296 x "-1o\r" 297 x "(apply '+ o<\0-1o\r" 298 x "2" 299 x "-2" 300 x "-2" 301 x "2" 302 x "" 303 x "H" 304 x "\0" 305 x "\"Another long one\r" 306 x "H" 307 x "" 308 x "<" 309 x "" 310 x ">" 311 x "\0" 312 x)) 313 ;;Sorting of columns 314 (fset 'ses-exercise-sort-column 315 (concat y ":(revert-buffer t t)\r" 316 x "\"Very long\r" 317 x "99\r" 318 x "o13\r" 319 x "(+ A3 B3\r" 320 x "7\r8\r(* A4 B4\r" 321 x "\0A\r" 322 x "\0B\r" 323 x "\0C\r" 324 x "o" 325 x "\0C\r" 326 x)) 327 ;;Simple cell printers 328 (fset 'ses-exercise-cell-printers 329 (concat y ":(revert-buffer t t)\r" 330 x "\"4\t76\r" 331 x "\"4\n7\r" 332 x "p\"{%S}\"\r" 333 x "p(\"[%s]\")\r" 334 x "p(\"<%s>\")\r" 335 x "\0" 336 x "p\r" 337 x "pnil\r" 338 x "pses-dashfill\r" 339 x "48\r" 340 x "\t" 341 x "\0p\r" 342 x "p\r" 343 x "pses-dashfill\r" 344 x "\0pnil\r" 345 x "5\r" 346 x "pses-center\r" 347 x "\"%s\"\r" 348 x "w8\r" 349 x "p\r" 350 x "p\"%.7g@\"\r" 351 x "\r" 352 x "\"%.6g#\"\r" 353 x "\"%.6g.\"\r" 354 x "\"%.6g.\"\r" 355 x "pidentity\r" 356 x "6\r" 357 x "\"UPCASE\r" 358 x "pdowncase\r" 359 x "(* 3 4\r" 360 x "p(lambda (x) '(\"Hi\"))\r" 361 x "p(lambda (x) '(\"Bye\"))\r" 362 x)) 363 ;;Spanning cell printers 364 (fset 'ses-exercise-spanning-printers 365 (concat y ":(revert-buffer t t)\r" 366 x "p\"%.6g*\"\r" 367 x "pses-dashfill-span\r" 368 x "5\r" 369 x "pses-tildefill-span\r" 370 x "\"4\r" 371 x "p\"$%s\"\r" 372 x "p(\"$%s\")\r" 373 x "8\r" 374 x "p(\"!%s!\")\r" 375 x "\t\"12345678\r" 376 x "pses-dashfill-span\r" 377 x "\"23456789\r" 378 x "\t" 379 x "(not t\r" 380 x "w6\r" 381 x "\"5\r" 382 x "o" 383 x "k" 384 x "k" 385 x "\t" 386 x "" 387 x "o" 388 x "2k" 389 x "k" 390 x)) 391 ;;Cut/copy/paste - within same buffer 392 (fset 'ses-exercise-paste-1buf 393 (concat y ":(revert-buffer t t)\r" 394 x "\0w" 395 x "" 396 x "o" 397 x "\"middle\r" 398 x "\0" 399 x "w" 400 x "\0" 401 x "w" 402 x "" 403 x "" 404 x "2y" 405 x "y" 406 x "y" 407 x ">" 408 x "y" 409 x ">y" 410 x "<" 411 x "p\"<%s>\"\r" 412 x "pses-dashfill\r" 413 x "\0" 414 x "" 415 x "" 416 x "y" 417 x "\r\0w" 418 x "\r" 419 x "3(+ G2 H1\r" 420 x "\0w" 421 x ">" 422 x "" 423 x "8(ses-average (ses-range G2 H2)\r" 424 x "\0k" 425 x "7" 426 x "" 427 x "(ses-average (ses-range E7 E9)\r" 428 x "\0" 429 x "" 430 x "(ses-average (ses-range E7 F7)\r" 431 x "\0k" 432 x "" 433 x "(ses-average (ses-range D6 E6)\r" 434 x "\0k" 435 x "" 436 x "2" 437 x "\"Line A\r" 438 x "pses-tildefill-span\r" 439 x "\"Subline A(1)\r" 440 x "pses-dashfill-span\r" 441 x "\0w" 442 x "" 443 x "" 444 x "\0w" 445 x "" 446 x)) 447 ;;Cut/copy/paste - between two buffers 448 (fset 'ses-exercise-paste-2buf 449 (concat y ":(revert-buffer t t)\r" 450 x "o\"middle\r\0" 451 x "" 452 x "4bses-test.txt\r" 453 x " " 454 x "\"xxx\0" 455 x "wo" 456 x "" 457 x "" 458 x "o\"\0" 459 x "wo" 460 x "o123.45\0" 461 x "o" 462 x "o1 \0" 463 x "o" 464 x ">y" 465 x "o symb\0" 466 x "oy2y" 467 x "o1\t\0" 468 x "o" 469 x "w9\np\"<%s>\"\n" 470 x "o\n2\t\"3\nxxx\t5\n\0" 471 x "oy" 472 x)) 473 ;;Export text, import it back 474 (fset 'ses-exercise-import-export 475 (concat y ":(revert-buffer t t)\r" 476 x "\0xt" 477 x "4bses-test.txt\r" 478 x "\n-1o" 479 x "xTo-1o" 480 x "'crunch\r" 481 x "pses-center-span\r" 482 x "\0xT" 483 x "o\n-1o" 484 x "\0y" 485 x "\0xt" 486 x "\0y" 487 x "12345678\r" 488 x "'bunch\r" 489 x "\0xtxT" 490 x))) 491 492(defun ses-exercise-macros () 493 "Executes all SES coverage-test macros." 494 (dolist (x '(ses-exercise-example 495 ses-exercise-new 496 ses-exercise-display 497 ses-exercise-formulas 498 ses-exercise-recalc 499 ses-exercise-header-row 500 ses-exercise-unsafe 501 ses-exercise-rows 502 ses-exercise-columns 503 ses-exercise-editing 504 ses-exercise-sort-column 505 ses-exercise-cell-printers 506 ses-exercise-spanning-printers 507 ses-exercise-paste-1buf 508 ses-exercise-paste-2buf 509 ses-exercise-import-export)) 510 (message "<Testing %s>" x) 511 (execute-kbd-macro x))) 512 513(defun ses-exercise-signals () 514 "Exercise code paths that lead to error signals, other than those for 515spreadsheet files with invalid formatting." 516 (message "<Checking for expected errors>") 517 (switch-to-buffer "ses-test.ses") 518 (deactivate-mark) 519 (ses-jump 'A1) 520 (ses-set-curcell) 521 (dolist (x '((ses-column-widths 14) 522 (ses-column-printers "%s") 523 (ses-column-printers ["%s" "%s" "%s"]) ;Should be two 524 (ses-column-widths [14]) 525 (ses-delete-column -99) 526 (ses-delete-column 2) 527 (ses-delete-row -1) 528 (ses-goto-data 'hogwash) 529 (ses-header-row -56) 530 (ses-header-row 99) 531 (ses-insert-column -14) 532 (ses-insert-row 0) 533 (ses-jump 'B8) ;Covered by preceding cell 534 (ses-printer-validate '("%s" t)) 535 (ses-printer-validate '([47])) 536 (ses-read-header-row -1) 537 (ses-read-header-row 32767) 538 (ses-relocate-all 0 0 -1 1) 539 (ses-relocate-all 0 0 1 -1) 540 (ses-select (ses-range A1 A2) 'x (ses-range B1 B1)) 541 (ses-set-cell 0 0 'hogwash nil) 542 (ses-set-column-width 0 0) 543 (ses-yank-cells #("a\nb" 544 0 1 (ses (A1 nil nil)) 545 2 3 (ses (A3 nil nil))) 546 nil) 547 (ses-yank-cells #("ab" 548 0 1 (ses (A1 nil nil)) 549 1 2 (ses (A2 nil nil))) 550 nil) 551 (ses-yank-pop nil) 552 (ses-yank-tsf "1\t2\n3" nil) 553 (let ((curcell nil)) (ses-check-curcell)) 554 (let ((curcell 'A1)) (ses-check-curcell 'needrange)) 555 (let ((curcell '(A1 . A2))) (ses-check-curcell 'end)) 556 (let ((curcell '(A1 . A2))) (ses-sort-column "B")) 557 (let ((curcell '(C1 . D2))) (ses-sort-column "B")) 558 (execute-kbd-macro "jB10\n2") 559 (execute-kbd-macro [?j ?B ?9 ?\n ?\C-@ ?\C-f ?\C-f cut]) 560 (progn (kill-new "x") (execute-kbd-macro ">n")) 561 (execute-kbd-macro "\0w"))) 562 (condition-case nil 563 (progn 564 (eval x) 565 (signal 'singularity-error nil)) ;Shouldn't get here 566 (singularity-error (error "No error from %s?" x)) 567 (error nil))) 568 ;;Test quit-handling in ses-update-cells. Cant' use `eval' here. 569 (let ((inhibit-quit t)) 570 (setq quit-flag t) 571 (condition-case nil 572 (progn 573 (ses-update-cells '(A1)) 574 (signal 'singularity-error nil)) 575 (singularity-error (error "Quit failure in ses-update-cells")) 576 (error nil)) 577 (setq quit-flag nil))) 578 579(defun ses-exercise-invalid-spreadsheets () 580 "Execute code paths that detect invalid spreadsheet files." 581 ;;Detect invalid spreadsheets 582 (let ((p&d "\n\n \n(ses-cell A1 nil nil nil nil)\n\n") 583 (cw "(ses-column-widths [7])\n") 584 (cp "(ses-column-printers [ses-center])\n") 585 (dp "(ses-default-printer \"%.7g\")\n") 586 (hr "(ses-header-row 0)\n") 587 (p11 "(2 1 1)") 588 (igp ses-initial-global-parameters)) 589 (dolist (x (list "(1)" 590 "(x 2 3)" 591 "(1 x 3)" 592 "(1 -1 0)" 593 "(1 2 x)" 594 "(1 2 -1)" 595 "(3 1 1)" 596 "\n\n (2 1 1)" 597 "\n\n \n(ses-cell)(2 1 1)" 598 "\n\n \n(x)\n(2 1 1)" 599 "\n\n\n \n(ses-cell A2)\n(2 2 2)" 600 "\n\n\n \n(ses-cell B1)\n(2 2 2)" 601 "\n\n \n(ses-cell A1 nil nil nil nil)\n(2 1 1)" 602 (concat p&d "(x)\n(x)\n(x)\n(x)\n" p11) 603 (concat p&d "(ses-column-widths)(x)\n(x)\n(x)\n" p11) 604 (concat p&d cw "(x)\n(x)\n(x)\n(2 1 1)") 605 (concat p&d cw "(ses-column-printers)(x)\n(x)\n" p11) 606 (concat p&d cw cp "(x)\n(x)\n" p11) 607 (concat p&d cw cp "(ses-default-printer)(x)\n" p11) 608 (concat p&d cw cp dp "(x)\n" p11) 609 (concat p&d cw cp dp "(ses-header-row)" p11) 610 (concat p&d cw cp dp hr p11) 611 (concat p&d cw cp dp "\n" hr igp))) 612 (condition-case nil 613 (with-temp-buffer 614 (insert x) 615 (ses-load) 616 (signal 'singularity-error nil)) ;Shouldn't get here 617 (singularity-error (error "%S is an invalid spreadsheet!" x)) 618 (error nil))))) 619 620(defun ses-exercise-startup () 621 "Prepare for coverage tests" 622 ;;Clean up from any previous runs 623 (condition-case nil (kill-buffer "ses-example.ses") (error nil)) 624 (condition-case nil (kill-buffer "ses-test.ses") (error nil)) 625 (condition-case nil (delete-file "ses-test.ses") (file-error nil)) 626 (delete-other-windows) ;Needed for "\C-xo" in ses-exercise-editing 627 (setq ses-mode-map nil) ;Force rebuild 628 (testcover-unmark-all "ses.el") 629 ;;Enable 630 (let ((testcover-1value-functions 631 ;;forward-line always returns 0, for us. 632 ;;remove-text-properties always returns t for us. 633 ;;ses-recalculate-cell returns the same " " any time curcell is a cons 634 ;;Macros ses-dorange and ses-dotimes-msg generate code that always 635 ;; returns nil 636 (append '(forward-line remove-text-properties ses-recalculate-cell 637 ses-dorange ses-dotimes-msg) 638 testcover-1value-functions)) 639 (testcover-constants 640 ;;These maps get initialized, then never changed again 641 (append '(ses-mode-map ses-mode-print-map ses-mode-edit-map) 642 testcover-constants))) 643 (testcover-start "ses.el" t)) 644 (require 'unsafep)) ;In case user has safe-functions = t! 645 646 647;;;######################################################################### 648(defun ses-exercise () 649 "Executes all SES coverage tests and displays the results." 650 (interactive) 651 (ses-exercise-startup) 652 ;;Run the keyboard-macro tests 653 (let ((safe-functions nil) 654 (ses-initial-size '(1 . 1)) 655 (ses-initial-column-width 7) 656 (ses-initial-default-printer "%.7g") 657 (ses-after-entry-functions '(forward-char)) 658 (ses-mode-hook nil)) 659 (ses-exercise-macros) 660 (ses-exercise-signals) 661 (ses-exercise-invalid-spreadsheets) 662 ;;Upgrade of old-style spreadsheet 663 (with-temp-buffer 664 (insert " \n\n \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") 665 (ses-load)) 666 ;;ses-vector-delete is always called from buffer-undo-list with the same 667 ;;symbol as argument. We'll give it a different one here. 668 (let ((x [1 2 3])) 669 (ses-vector-delete 'x 0 0)) 670 ;;ses-create-header-string behaves differently in a non-window environment 671 ;;but we always test under windows. 672 (let ((window-system (not window-system))) 673 (scroll-left 7) 674 (ses-create-header-string)) 675 ;;Test for nonstandard after-entry functions 676 (let ((ses-after-entry-functions '(forward-line)) 677 ses-mode-hook) 678 (ses-read-cell 0 0 1) 679 (ses-read-symbol 0 0 t))) 680 ;;Tests with unsafep disabled 681 (let ((safe-functions t) 682 ses-mode-hook) 683 (message "<Checking safe-functions = t>") 684 (kill-buffer "ses-example.ses") 685 (find-file "ses-example.ses")) 686 ;;Checks for nonstandard default values for new spreadsheets 687 (let (ses-mode-hook) 688 (dolist (x '(("%.6g" 8 (2 . 2)) 689 ("%.8g" 6 (3 . 3)))) 690 (let ((ses-initial-size (nth 2 x)) 691 (ses-initial-column-width (nth 1 x)) 692 (ses-initial-default-printer (nth 0 x))) 693 (with-temp-buffer 694 (set-buffer-modified-p t) 695 (ses-mode))))) 696 ;;Test error-handling in command hook, outside a macro. 697 ;;This will ring the bell. 698 (let (curcell-overlay) 699 (ses-command-hook)) 700 ;;Due to use of run-with-timer, ses-command-hook sometimes gets called 701 ;;after we switch to another buffer. 702 (switch-to-buffer "*scratch*") 703 (ses-command-hook) 704 ;;Print results 705 (message "<Marking source code>") 706 (testcover-mark-all "ses.el") 707 (testcover-next-mark) 708 ;;Cleanup 709 (delete-other-windows) 710 (kill-buffer "ses-test.txt") 711 ;;Could do this here: (testcover-end "ses.el") 712 (message "Done")) 713 714;;; arch-tag: 87052ba4-5cf8-46cf-9375-fe245f3360b8 715;; testcover-ses.el ends here. 716