cgit.sxemacs.org Git - sxemacs/blob - tests/automated/syntax-tests.el

   1 ;; Copyright (C) 1999 Free Software Foundation, Inc.
   2
   3 ;; Author: Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
   4 ;; Maintainer: Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
   5 ;; Created: 1999
   6 ;; Keywords: tests
   7
   8 ;; This file is part of SXEmacs.
   9
  10 ;; SXEmacs is free software: you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by the
  12 ;; Free Software Foundation, either version 3 of the License, or (at your
  13 ;; option) any later version.
  14
  15 ;; SXEmacs is distributed in the hope that it will be
  16 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Synched up with: Not in FSF.
  24
  25 ;;; Commentary:
  26
  27 ;; Test syntax related functions.
  28 ;; Right now it tests scan_words using forward-word and backward-word.
  29 ;; See test-harness.el for instructions on how to run these tests.
  30
  31 ;;; Notation
  32 ;; W:   word constituent character.
  33 ;; NW:  non word constituent character.
  34 ;; -!-: current point.
  35 ;; EOB: end of buffer
  36 ;; BOB: beginning of buffer.
  37
  38 ;; Algorithm of scan_words is simple.  It just searches SW and then
  39 ;; moves to NW.  When with MULE, it also stops at word boundary.  Word
  40 ;; boundary is tricky and listing all possible cases will be huge.
  41 ;; Those test are omitted here as it doesn't affect core
  42 ;; functionality.
  43
  44 (defun test-forward-word (string stop)
  45   (goto-char (point-max))
  46   (let ((point (point)))
  47     (insert string)
  48     (goto-char point)
  49     (forward-word 1)
  50     (Assert (eq (point) (+ point stop)))))
  51
  52 (with-temp-buffer
  53   ;; -!- W NW
  54   (test-forward-word "W " 1)
  55   (test-forward-word "WO " 2)
  56   ;; -!- W EOB
  57   (test-forward-word "W" 1)
  58   (test-forward-word "WO" 2)
  59   ;; -!- NW EOB
  60   (test-forward-word " " 1)
  61   (test-forward-word " !" 2)
  62   ;; -!- NW W NW
  63   (test-forward-word " W " 2)
  64   (test-forward-word " WO " 3)
  65   (test-forward-word " !W " 3)
  66   (test-forward-word " !WO " 4)
  67   ;; -!- NW W EOB
  68   (test-forward-word " W" 2)
  69   (test-forward-word " WO" 3)
  70   (test-forward-word " !W" 3)
  71   (test-forward-word " !WO" 4))
  72
  73 (defun test-backward-word (string stop)
  74   (goto-char (point-min))
  75   (insert string)
  76   (let ((point (point)))
  77     (backward-word 1)
  78     (Assert (eq (point) (- point stop)))))
  79
  80 (with-temp-buffer
  81   ;; NW W -!-
  82   (test-backward-word " W" 1)
  83   (test-backward-word " WO" 2)
  84   ;; BOB W -!-
  85   (test-backward-word "W" 1)
  86   (test-backward-word "WO" 2)
  87   ;; BOB NW -!-
  88   ;; -!-NW EOB
  89   (test-backward-word " " 1)
  90   (test-backward-word " !" 2)
  91   ;; NW W NW -!-
  92   (test-backward-word " W " 2)
  93   (test-backward-word " WO " 3)
  94   (test-backward-word " W !" 3)
  95   (test-backward-word " WO !" 4)
  96   ;; BOB W NW -!-
  97   (test-backward-word "W " 2)
  98   (test-backward-word "WO " 3)
  99   (test-backward-word "W !" 3)
 100   (test-backward-word "WO !" 4))
 101
 102 ;; Works like test-forward-word, except for the following:
 103 ;; after <string> is inserted, the syntax-table <apply-syntax>
 104 ;; is applied to position <apply-pos>.
 105 ;; <apply-pos> can be in the form (start . end), or can be a
 106 ;; character position.
 107 (defun test-syntax-table (string apply-pos apply-syntax stop)
 108   ;; We don't necessarily have syntax-table properties ...
 109   (when (boundp 'lookup-syntax-properties) ; backwards compatible kludge
 110     ;; ... and they may not be enabled by default if we do.
 111     (setq lookup-syntax-properties t)
 112     (goto-char (point-max))
 113     (unless (consp apply-pos)
 114       (setq apply-pos `(,apply-pos . ,(+ 1 apply-pos))))
 115     (let ((point (point)))
 116       (insert string)
 117       (put-text-property (+ point (car apply-pos)) (+ point (cdr apply-pos))
 118                          'syntax-table apply-syntax)
 119       (goto-char point)
 120       (forward-word 1)
 121       (Assert (eq (point) (+ point stop))))))
 122
 123 ;; test syntax-table extents
 124 (with-temp-buffer
 125   ;; Apply punctuation to word
 126   (test-syntax-table "WO" 1 `(,(syntax-string-to-code ".")) 1)
 127   ;; Apply word to punctuation
 128   (test-syntax-table "W." 1 `(,(syntax-string-to-code "w")) 2))
 129
 130 ;; Test forward-comment at buffer boundaries
 131 ;; #### The second Assert fails (once interpreted, once compiled) on 21.4.9
 132 ;; with sjt's version of Andy's syntax-text-property-killer patch.
 133 (with-temp-buffer
 134   (if (not (fboundp 'c-mode))
 135       ;; #### This whole thing should go inside a macro Skip-Test
 136       (let* ((reason "c-mode unavailable")
 137              (count (gethash reason skipped-test-reasons)))
 138         ;;(message "%S: %S" reason count)
 139         (puthash reason (if (null count) 1 (1+ count))
 140                  skipped-test-reasons)
 141         (Print-Skip "comment and parse-partial-sexp tests" reason))
 142     (c-mode)
 143
 144     (insert "// comment\n")
 145     (forward-comment -2)
 146     (Assert (eq (point) (point-min)))
 147
 148     (let ((point (point)))
 149       (insert "/* comment */")
 150       (goto-char point)
 151       (forward-comment 2)
 152       (Assert (eq (point) (point-max)))
 153
 154       ;; this last used to crash
 155       (parse-partial-sexp point (point-max)))))