From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Aleksey Cherepanov Newsgroups: gmane.emacs.bugs Subject: bug#16800: 24.3; flyspell works slow on very short words at the end of big file Date: Sat, 1 Mar 2014 14:33:05 +0400 Message-ID: <20140301103305.GA600@openwall.com> References: <83ios72j8b.fsf@gnu.org> <20140222185511.GA23643@openwall.com> <838ut23lo9.fsf@gnu.org> <20140223195659.GA23581@openwall.com> <20140223230251.GA30257@openwall.com> <20140224160317.GA2475@openwall.com> <20140226203202.GA23749@agmartin.aq.upm.es> <20140228114545.GA8669@agmartin.aq.upm.es> <20140228231141.GA20782@openwall.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="azLHFNyN32YCQGCU" X-Trace: ger.gmane.org 1393670054 19134 80.91.229.3 (1 Mar 2014 10:34:14 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 1 Mar 2014 10:34:14 +0000 (UTC) Cc: 16800@debbugs.gnu.org To: Agustin Martin Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Mar 01 11:34:22 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1WJhFN-0002mO-Dq for geb-bug-gnu-emacs@m.gmane.org; Sat, 01 Mar 2014 11:34:21 +0100 Original-Received: from localhost ([::1]:59126 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WJhFN-00064L-2e for geb-bug-gnu-emacs@m.gmane.org; Sat, 01 Mar 2014 05:34:21 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58385) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WJhFC-00061z-IV for bug-gnu-emacs@gnu.org; Sat, 01 Mar 2014 05:34:17 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1WJhF5-00032F-6u for bug-gnu-emacs@gnu.org; Sat, 01 Mar 2014 05:34:10 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:44168) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WJhF5-00031y-1n for bug-gnu-emacs@gnu.org; Sat, 01 Mar 2014 05:34:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1WJhF4-0003m4-IQ for bug-gnu-emacs@gnu.org; Sat, 01 Mar 2014 05:34:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Aleksey Cherepanov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 01 Mar 2014 10:34:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 16800 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 16800-submit@debbugs.gnu.org id=B16800.139366999514448 (code B ref 16800); Sat, 01 Mar 2014 10:34:02 +0000 Original-Received: (at 16800) by debbugs.gnu.org; 1 Mar 2014 10:33:15 +0000 Original-Received: from localhost ([127.0.0.1]:45350 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1WJhEI-0003kx-3x for submit@debbugs.gnu.org; Sat, 01 Mar 2014 05:33:15 -0500 Original-Received: from mail-la0-f52.google.com ([209.85.215.52]:45157) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1WJhEE-0003kl-CU for 16800@debbugs.gnu.org; Sat, 01 Mar 2014 05:33:11 -0500 Original-Received: by mail-la0-f52.google.com with SMTP id ec20so2656591lab.11 for <16800@debbugs.gnu.org>; Sat, 01 Mar 2014 02:33:09 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=date:from:to:cc:subject:message-id:references:mime-version :content-type:content-disposition:in-reply-to:user-agent; bh=g29TMMy4cKgaVeAE5dZG98wixsPcUtRFxDUJ32kI0FY=; b=VHyxvYt1xABbKfBXN7CpyBm0qVddP3m0WiRhZJ62UiJ4W46WLxdHDZ2iDGJgZZ0K4N LqGoQZeXSl59t5qDmas8bKgHuJrlsjQbBhEgaRaTJvpbshka8FkIroyfI7G15Fghwa62 M9LAygkynPrcN6XePydvAWJ/+EP/b1tGSALRCv1FSGgB7Nr59KSvqwGCKa1oGPdN57My Kj8RCNRE7b/pyWD2MLF3WuhWriMI3Hb5vfLtRTNeXrLU4FEaMQL7V9phZ8xwvGR2+sMX +8862/vixiPsnG6rW9rQiiNdAOw5RekFxeSCsa9jOWT2iSnePxSX4gZLH2VHWLYfCXum saPA== X-Received: by 10.112.29.236 with SMTP id n12mr777140lbh.61.1393669989203; Sat, 01 Mar 2014 02:33:09 -0800 (PST) Original-Received: from openwall.com ([188.123.230.115]) by mx.google.com with ESMTPSA id h7sm7573245lbj.1.2014.03.01.02.33.07 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Sat, 01 Mar 2014 02:33:07 -0800 (PST) Content-Disposition: inline In-Reply-To: <20140228231141.GA20782@openwall.com> User-Agent: Mutt/1.5.21 (2010-09-15) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:86432 Archived-At: --azLHFNyN32YCQGCU Content-Type: text/plain; charset=us-ascii Content-Disposition: inline On Sat, Mar 01, 2014 at 03:11:41AM +0400, Aleksey Cherepanov wrote: > Wow! Your 'if' in 'while's condition is very elegant. Nice! > > On Fri, Feb 28, 2014 at 12:45:45PM +0100, Agustin Martin wrote: > > Please find attached my first candidate for commit. Is similar to what I > > sent before, but needed to add an explicit check for word at eob in > > `flyspell-word-search-forward'. > > > > Will try to have more testing before committing. Seems to work well with the > > file generated by your one-liner, even with corner cases like new > > misspellings added at bob or eob, but the wider the testing the better. > > I've wrote a small fuzzer. It is in attach. To run it: > $ LANG=C emacs -Q --eval '(load-file "t2.el")' > Then C-j to start. It modifies buffer you are in. There is a mistake in my-try-mixed-pairs, fixed version is attached. > (kbd "nd SPC and SPC nd C-b") fails to highlight the second "nd" as > duplicate. It is a problem with bound equal to (length word) in > -backward function. I did not check it when I wrote it. > > + (search-forward word (length word) t)))) > (search-forward word (1+ (length word)) t)))) (1+ ...) is wrong, it should be similar to -forward: (+ (point-min) ...) because (point-min) is not always 1 (narrowing could change this). BTW flyspell does not escape restrictions/narrowing when it searches for duplicate. Would not it be more convenient to widen before search? Like (save-restriction (widen) ... search ... > One "nd" is colored as duplicate due to -backward function after that > fix. I did not touch it yet because it is a time for a break for me. Thanks! -- Regards, Aleksey Cherepanov --azLHFNyN32YCQGCU Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="t2.el" (require 'cl) (require 'flyspell) (setq my-fuzzer-buffer-name "*temp for fuzzer*") (switch-to-buffer my-fuzzer-buffer-name) (unless (= (point-min) (point-max)) (error "Could not operate on non-empty buffer")) (flyspell-mode 1) (random t) ;; Orig (defun my-test-backward-orig (word bound &optional ignore-case) (save-excursion (let ((r '()) (inhibit-point-motion-hooks t) p) (while (and (not r) (setq p (search-backward word bound t))) (let ((lw (flyspell-get-word))) (if (and (consp lw) (if ignore-case (string-equal (downcase (car lw)) (downcase word)) (string-equal (car lw) word))) (setq r p) (goto-char p)))) r))) (defun my-test-forward-orig (word bound) (save-excursion (let ((r '()) (inhibit-point-motion-hooks t) p) (while (and (not r) (setq p (search-forward word bound t))) (let ((lw (flyspell-get-word))) (if (and (consp lw) (string-equal (car lw) word)) (setq r p) (goto-char (1+ p))))) r))) ;; Agustin Martin (defun my-test-backward-agustin (word bound &optional ignore-case) (save-excursion (let* ((r '()) (inhibit-point-motion-hooks t) (flyspell-not-casechars (flyspell-get-not-casechars)) (word-re (concat flyspell-not-casechars (regexp-quote word) flyspell-not-casechars)) p) (while (and (not r) (setq p (if (re-search-backward word-re bound t) (progn (forward-char) (point)) ;; Check if word is at bob (goto-char (point-min)) (search-forward word (length word) t)))) (let ((lw (flyspell-get-word))) (if (and (consp lw) (if ignore-case (string-equal (downcase (car lw)) (downcase word)) (string-equal (car lw) word))) (setq r p) (goto-char p)))) r))) (defun my-test-forward-agustin (word bound) (save-excursion (let* ((r '()) (inhibit-point-motion-hooks t) (word-end (nth 2 (flyspell-get-word))) (flyspell-not-casechars (flyspell-get-not-casechars)) (word-re (concat flyspell-not-casechars (regexp-quote word) flyspell-not-casechars)) p) (while (and (not r) (setq p (if (= word-end (point-max)) nil ;; Current word is at e-o-b. No forward search (if (re-search-forward word-re bound t) ;; word-re match ends one char after word (progn (backward-char) (point)) ;; Check above does not match similar word at e-o-b (goto-char (point-max)) (search-backward word (- (point-max) (length word)) t))))) (let ((lw (flyspell-get-word))) (if (and (consp lw) (string-equal (car lw) word)) (setq r p) (goto-char (1+ p))))) r))) ;; Fixed (defun my-test-backward-agustin-fixed (word bound &optional ignore-case) ;; (my-test-backward-agustin word bound ignore-case)) (save-excursion (let* ((r '()) (inhibit-point-motion-hooks t) (flyspell-not-casechars (flyspell-get-not-casechars)) (word-re (concat flyspell-not-casechars (regexp-quote word) flyspell-not-casechars)) p) (while (and (not r) (setq p (if (re-search-backward word-re bound t) (progn (forward-char) (point)) ;; Check if word is at bob (goto-char (point-min)) (search-forward word (+ (point-min) (length word)) t)))) (let ((lw (flyspell-get-word))) (if (and (consp lw) (if ignore-case (string-equal (downcase (car lw)) (downcase word)) (string-equal (car lw) word))) (setq r p) (goto-char p)))) r))) (defun my-test-forward-agustin-fixed (word bound) (save-excursion (let* ((r '()) (inhibit-point-motion-hooks t) (flyspell-not-casechars (flyspell-get-not-casechars)) (word-re (concat flyspell-not-casechars (regexp-quote word) flyspell-not-casechars)) p) (flyspell-get-word) (while (and (not r) (setq p (if (eobp) nil ;; Current word is at e-o-b. No forward search (if (re-search-forward word-re bound t) ;; word-re match ends one char after word (progn (backward-char) (point)) ;; Check above does not match similar word at e-o-b (goto-char (point-max)) (and (search-backward word (- (point-max) (length word)) t) (goto-char (point-max))))))) (let ((lw (flyspell-get-word))) (if (and (consp lw) (string-equal (car lw) word)) (setq r p) (goto-char (1+ p))))) r))) (defun my-make-test-macro () (let* ((good "met") (sep "SPC") (bad "nd") (oc "'") (bol "C-a") ;; not really eol but enough (eol "C-e") (parts (list good sep bad oc bol eol)) (len (length parts))) (eval `(kbd ,(mapconcat (lambda (a) (nth (random len) parts)) (make-list (1+ (random 100)) 0) " "))))) ;; nil if everythings is equal, ;; 'badtext if text is not equal, ;; position is the first position with different properties. (defun my-compare-strings-with-properties (a b) (if (string= (car a) (car b)) (let ((len (length (car a))) (pos 0) (badpos nil) (faces1 (cadr a)) (faces2 (cadr b))) (while (and (not badpos) (< pos len)) (unless (equal (nth pos faces1) (nth pos faces2)) (setq badpos pos)) ;; (message ">> %d" pos) (setq pos (1+ pos))) ;; (if badpos ;; (progn ;; (message ":>> faces1 %S" faces1) ;; (message ":>> faces2 %S" faces2))) badpos) 'badtext)) (defun my-try-macro (macro) (let ((strings ;; (message ">> count = %d, macro = %S" count macro) (mapcar (lambda (name) (delete-region (point-min) (point-max)) (letf (((symbol-function 'flyspell-word-search-forward) (intern (concat "my-test-forward-" (symbol-name name)))) ((symbol-function 'flyspell-word-search-backward) (intern (concat "my-test-backward-" (symbol-name name))))) ;; (message ">> pre %S %d" name count) (execute-kbd-macro macro) ;; (message ">> post %S %d" name count) ) (list (buffer-string) (mapcar (lambda (pos) (get-char-property pos 'face)) (number-sequence (point-min) (point-max))))) '(orig new)))) (my-compare-strings-with-properties (car strings) (cadr strings)))) ;; It may not reduce to the minimun in one run. It fails at reductions ;; if 2 or more chars should be removed at the same time. (defun my-reduce (macro) (let ((bad (my-try-macro macro)) (fails 0) newmacro) (if bad (while (< fails 100) (let ((pos (random (length macro)))) (setq newmacro (concat (substring macro 0 pos) (substring macro (1+ pos)))) ;; (message ">> %S" macro) ;; (message ">> %S" newmacro) (if (my-try-macro newmacro) (progn (setq fails 0) (setq macro newmacro)) (setq fails (1+ fails))))) (message ":>> We reduce only faulty macros")) macro)) ;; Change this to use other functions instead of -agustin-fixed (defun my-reset-new () (defun my-test-backw+ard-new (word bound &optional ignore-case) (my-test-backward-agustin-fixed word bound ignore-case)) (defun my-test-forward-new (word bound) (my-test-forward-agustin-fixed word bound))) (my-reset-new) (defun my-try-mixed-pairs (macro) (unwind-protect (if (my-try-macro macro) (progn (my-reset-new) (defun my-test-backward-new (word bound &optional ignore-case) (my-test-backward-orig word bound ignore-case)) (if (my-try-macro macro) (message ":>> Difference is from -forward function")) (my-reset-new) (defun my-test-forward-new (word bound) (my-test-forward-orig word bound)) (if (my-try-macro macro) (message ":>> Difference is from -backward function"))) (message ":>> We mix pairs only for faulty macros")) (my-reset-new))) (defun my-fuzz () (interactive) (unless (string= (ispell-get-otherchars) "[']") (error "Unexpected not-casechars value")) (buffer-disable-undo) (unwind-protect (let ((more t) (count 0) (time (current-time))) (while (and more (< count (if my-macro 1 15))) (let* ((macro (or my-macro (my-make-test-macro))) (bad (my-try-macro macro))) (setq more (not bad)) (unless more (message ":>> Bad at %S running %S" bad macro) (my-try-mixed-pairs macro) (message ":>> Reduced macro: %S" (my-reduce macro)))) (setq count (1+ count))) (message ":>> Fuzzing: %d macros are finished in %S" count (subtract-time (current-time) time)) (message ":>> %s" (if more "Without differences" "There are differences"))) (buffer-enable-undo)) nil) (global-set-key (kbd "C-j") 'my-fuzz) (split-window-right) (other-window 1) (view-echo-area-messages) (other-window 1) ;; For manual debug ;; (defun flyspell-word-search-backward (word bound &optional ignore-case) ;; (my-test-backward-agustin-fixed word bound ignore-case)) ;; (defun flyspell-word-search-forward (word bound) ;; (my-test-forward-agustin-fixed word bound)) ;; Define non-nil to run only one test with this macro not randomly (setq my-macro nil) ;; (setq my-macro (kbd "nd SPC and SPC nd C-a")) ;; (setq my-macro (kbd "nd SPC nd C-a")) ;; (setq my-macro (kbd "nd SPC and C-a")) (setq my-macro (kbd "n SPC n C-a")) ;; (setq my-macro (kbd "nd C-e")) --azLHFNyN32YCQGCU--