comparison tests/automated/syntax-tests.el @ 1024:ccaf90c5a53a

[xemacs-hg @ 2002-10-02 09:29:37 by stephent] 21.4 -> R21.5 stuff manual improvements <87k7l1p6su.fsf@tleepslib.sk.tsukuba.ac.jp> regexp tests <87fzvpp6mf.fsf@tleepslib.sk.tsukuba.ac.jp> add-to-list doc Ville Skyttä <87bs6dp6io.fsf@tleepslib.sk.tsukuba.ac.jp> Move filename associations Ville Skyttä <877kh1p6ee.fsf@tleepslib.sk.tsukuba.ac.jp> lookup-syntax-properties <87admil2e0.fsf_-_@tleepslib.sk.tsukuba.ac.jp> fix stale submatches <873crpp50v.fsf_-_@tleepslib.sk.tsukuba.ac.jp> info for developers <87y99hnqc4.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Wed, 02 Oct 2002 09:31:40 +0000
parents ea6a06f7bf2c
children 0d33547d9ed3
comparison
equal deleted inserted replaced
1023:ce9bdd48654f 1024:ccaf90c5a53a
105 ;; after <string> is inserted, the syntax-table <apply-syntax> 105 ;; after <string> is inserted, the syntax-table <apply-syntax>
106 ;; is applied to position <apply-pos>. 106 ;; is applied to position <apply-pos>.
107 ;; <apply-pos> can be in the form (start . end), or can be a 107 ;; <apply-pos> can be in the form (start . end), or can be a
108 ;; character position. 108 ;; character position.
109 (defun test-syntax-table (string apply-pos apply-syntax stop) 109 (defun test-syntax-table (string apply-pos apply-syntax stop)
110 (goto-char (point-max)) 110 ;; We don't necessarily have syntax-table properties ...
111 (unless (consp apply-pos) 111 (when (fboundp 'lookup-syntax-properties) ; backwards compatible kludge
112 (setq apply-pos `(,apply-pos . ,(+ 1 apply-pos)))) 112 ;; ... and they may not be enabled by default if we do.
113 (let ((point (point))) 113 (setq lookup-syntax-properties t)
114 (insert string) 114 (goto-char (point-max))
115 (put-text-property (+ point (car apply-pos)) (+ point (cdr apply-pos)) 115 (unless (consp apply-pos)
116 'syntax-table apply-syntax) 116 (setq apply-pos `(,apply-pos . ,(+ 1 apply-pos))))
117 (goto-char point) 117 (let ((point (point)))
118 (forward-word 1) 118 (insert string)
119 (Assert (eq (point) (+ point stop))))) 119 (put-text-property (+ point (car apply-pos)) (+ point (cdr apply-pos))
120 'syntax-table apply-syntax)
121 (goto-char point)
122 (forward-word 1)
123 (Assert (eq (point) (+ point stop))))))
120 124
121 ;; test syntax-table extents 125 ;; test syntax-table extents
122 (with-temp-buffer 126 (with-temp-buffer
123 ;; Apply punctuation to word 127 ;; Apply punctuation to word
124 (test-syntax-table "WO" 1 `(,(syntax-string-to-code ".")) 1) 128 (test-syntax-table "WO" 1 `(,(syntax-string-to-code ".")) 1)
125 ;; Apply word to punctuation 129 ;; Apply word to punctuation
126 (test-syntax-table "W." 1 `(,(syntax-string-to-code "w")) 2)) 130 (test-syntax-table "W." 1 `(,(syntax-string-to-code "w")) 2))
127 131
128 ;; Test forward-comment at buffer boundaries 132 ;; Test forward-comment at buffer boundaries
133 ;; #### The second Assert fails (once interpreted, once compiled) on 21.4.9
134 ;; with sjt's version of Andy's syntax-text-property-killer patch.
129 (with-temp-buffer 135 (with-temp-buffer
130 (if (not (fboundp 'c-mode)) 136 (if (not (fboundp 'c-mode))
131 ;; #### This whole thing should go inside a macro Skip-Test 137 ;; #### This whole thing should go inside a macro Skip-Test
132 (let* ((reason "c-mode unavailable") 138 (let* ((reason "c-mode unavailable")
133 (count (gethash reason skipped-test-reasons))) 139 (count (gethash reason skipped-test-reasons)))