--- a/tests/reproduce-bugs.el	Thu Dec 20 09:51:51 2007 -0700
+++ b/tests/reproduce-bugs.el	Fri Dec 21 03:31:41 2007 -0800
@@ -1,4 +1,4 @@
-;;; reproduce-bugs.el --- reproduce bugs in XEmacs;
+;;; reproduce-bugs.el --- reproduce bugs in XEmacs
 
 ;; Copyright (C) 1997  Free Software Foundation, Inc.
 ;; Copyright (C) 1997  Sun Microsystems, Inc.
@@ -26,29 +26,104 @@
 
 ;;; Commentary:
 
-;; Reproduce XEmacs bugs, so that they can get fixed.
-;; Especially, make XEmacs crash.
+;; Reproduce XEmacs crashes, so that they can get fixed.
+;; A table of bugs is created.  You can list, describe, or reproduce bugs.
+
+;; Non-crash bugs should not be in this file; they should be placed in
+;; an appropriate file in the tests/automated suite.
 ;; You may need to use a debug version of XEmacs to reproduce some of these.
 
-;; Several global keybindings are created, each of which exhibits a bug.
-
 ;; For XEmacs maintainers and other masochists.
-
 ;; It's a bad idea to rely on code in this file continuing to work in
 ;; the same way. :-)
 
 ;; #### This file should be cleaned up and renamed reproduce-crashes.el.
-;; #### Bugs need docstrings.
-;; #### Fixed bugs should become regression tests.
+;; #### Bugs < 11 need to be tested and versions where they pass recorded.
+;; #### Fixed bugs should become regression tests, maybe?
+;; #### Non-crashes should be copied (not moved) to tests/automatic.
+;; #### Do the autoloads make any sense?
+;; #### `list-bugs' should optionally sort on status.
+;; #### Bugs that depend on features (eg, Mule) should check for them and
+;;      document them.
 
 ;;; Code:
 
-(defvar bug-hashtable (make-hashtable 10))
+;; UI entry points
+
+(defun reproduce-bug (number)
+  "Reproduce XEmacs bugs, so that they can get fixed.
+Especially, make XEmacs crash.
+See reproduce-bugs.el for bug descriptions and bug numbers.
+A debug version of XEmacs may be needed to reproduce some bugs."
+  (interactive "nBug Number: ")
+  (funcall (nth 0 (gethash number bug-hashtable))))
+
+(defun describe-bug (number &optional show-code)
+  "Describe the bug with index NUMBER in a popup window.
+If optional argument SHOW-CODE is non-nil, also display the reproduction code."
+  (interactive "nBug number: \ncShow code? [y/N] ")
+  (setq show-code (cond ((not (interactive-p)) show-code)
+			((member show-code '(?y ?Y)) t)
+			(t nil)))
+  (with-displaying-temp-buffer (format "Bug %d" number)
+    (let ((bug (gethash number bug-hashtable)))
+      (princ (format "Bug #%d is %s.\n%s\n\n%s"
+		     number
+		     (nth 1 bug)
+		     (nth 2 bug)
+		     (if show-code (pp-to-string (nth 0 bug)) ""))))))
 
-(defmacro defbug (bug-number &rest body)
-  `(puthash ,bug-number (lambda () ,@body) bug-hashtable))
+(defun list-bugs ()
+  "List bugs most recent first, each with brief description in a popup window.
+Assumes a maximum of 999 bugs and a minimum of 80 column width window."
+  (interactive)
+  (with-displaying-temp-buffer "*Bug list*"
+    (princ " #    status                      description\n")
+    (let (buglist)
+      (maphash (lambda (number bug)
+		 (push (format "%3d %-9s %s"
+			       number
+			       (nth 1 bug)
+			       (let ((description (nth 2 bug)))
+				 (save-match-data
+				   (string-match "\\(.*\\)\\(\n\\|$\\)"
+						 description)
+				   (match-string 1 description))))
+		       buglist))
+	       bug-hashtable)
+      (setq buglist (sort buglist (lambda (b1 b2) (string< b2 b1))))
+      (while buglist
+	(let ((bug (pop buglist)))
+	  (princ (if (< (length bug) 79) bug (substring bug 0 78)))
+	  (terpri))))))
+
+;; Database and utilities (internal)
+
+(defvar bug-hashtable (make-hashtable 10)
+  "Table of bugs, keyed by bug index number.
+The value is a list (LAMBDA STATUS DOCSTRING), where LAMBDA is a lambda
+expression reproducing the bug, and STATUS and DOCSTRING describe the bug.
+For details, see `defbug'.")
 
 (put 'defbug 'lisp-indent-function 'defun)
+(defmacro defbug (bug-number status docstring &rest body)
+  "Record a bug with key BUG-NUMBER and value (LAMBDA STATUS DOCSTRING).
+LAMBDA is a lambda expression which when called executes BODY.
+BUG-NUMBER is the bug's index number, a positive integer.
+STATUS is the current status of the bug, one of
+  fixed         The bug has been diagnosed and fixed.
+  diagnosed     The bug has been localized but not fixed.
+  current       The bug has been reported and reproduced but cause is unknown.
+  legacy        The bug is undocumented but presumed fixed.
+DOCSTRING should be a string describing the bug, including any relevant
+descriptive information and references to archived mailing list traffic or
+a BTS issue.
+BODY is a sequence of expressions to execute to reproduce the bug."
+  (let ((body (if (stringp docstring) body (cons docstring body)))
+	(docstring (if (stringp docstring) docstring "[docstring omitted]")))
+    `(puthash ,bug-number
+              '((lambda () ,@body) ,status ,docstring)
+              bug-hashtable)))
 
 (defconst bug-buffer
   (save-excursion
@@ -56,33 +131,21 @@
     (erase-buffer)
     (current-buffer)))
 
-;;;####autoload
-(defun reproduce-bug (number)
-  "Reproduce XEmacs bugs, so that they can get fixed.
-Especially, make XEmacs crash.
-See reproduce-bugs.el for bug descriptions and bug numbers.
-A debug version of XEmacs may be needed to reproduce some bugs."
-  (interactive "nBug Number: ")
-  (funcall (gethash number bug-hashtable)))
 
-;;; Change this to your preferred key-binding
-
-;; (global-set-key  [(control ?Z)] 'reproduce-bug)
-
+;;; ------------------------------------------------------------------
 ;;;; Bugs follow:
 
-;;; ------------------------------------------------------------------
-;;; Crash in search due to backward movement
-;;; Need Mule build with error checking in 21.5.28.
-;;; Fatal error: assertion failed,
-;;; file /Users/steve/Software/XEmacs/alioth/xemacs/src/search.c, line 1487,
-;;; (this_pos) > ((Bytebpos) 1) && this_pos <= ((buf)->text->z + 0)
-;;; Reported: <475B104F.2070807@barco.com>
-;;;           <87hcixwkh4.fsf@uwakimon.sk.tsukuba.ac.jp>
-;;; Fixed:    <87hcixwkh4.fsf@uwakimon.sk.tsukuba.ac.jp>
-(defbug 10
+(defbug 11 fixed
+  "Crash in search due to backward movement.
+Need Mule build with error checking in 21.5.28.
+Fatal error: assertion failed,
+file /Users/steve/Software/XEmacs/alioth/xemacs/src/search.c, line 1487,
+(this_pos) > ((Bytebpos) 1) && this_pos <= ((buf)->text->z + 0)
+Reported: <475B104F.2070807@barco.com>
+          <87hcixwkh4.fsf@uwakimon.sk.tsukuba.ac.jp>
+Fixed:    <87hcixwkh4.fsf@uwakimon.sk.tsukuba.ac.jp>"
   (switch-to-buffer (get-buffer-create "*crash me*"))
-  ;; doozy is the keystroke version of the keyboard macro
+  ;; doozy is the keystroke equivalent of the keyboard macro
   ;; "IAI" C-b C-b C-s C-x
   (let ((doozy [;;(control ?x) ?b ?j ?u ?n ?k return
 		?I ?A ?I
@@ -91,20 +154,18 @@
     (execute-kbd-macro doozy)))
 
 
-;;; ------------------------------------------------------------------
-;;; Crash on trace-function
-;;; Fatal error: assertion failed, file src/eval.c, line 1405, abort()
-(defbug 1
+(defbug 10 current
+  "Crash on trace-function
+Fatal error: assertion failed, file src/eval.c, line 1405, abort()"
   (trace-function 'record-buffer bug-buffer)
   (pop-to-buffer bug-buffer))
 
 
-;;; ------------------------------------------------------------------
-;;; Crashes with stack overflow
-;;; Should give error via barf-if-buffer-read-only
-;;; Fatal error: assertion failed, file src/eval.c, line 1874, abort()
-;; This bug has been fixed. -sb
-(defbug 2
+(defbug 9 current
+  "Crashes with stack overflow
+Should give error via barf-if-buffer-read-only
+Fatal error: assertion failed, file src/eval.c, line 1874, abort()
+This bug has been fixed. -sb"
   (switch-to-buffer bug-buffer)
   ;; The following line should contain a number of eight-bit characters
   (insert "²èÌÌËè¤Î°ÜÆ°¤Ï¤Ç¤­¤ë¤è¤¦¤Ë¤Ê¤ê¤Þ¤·¤¿¡£º£Å٤ϡ¢²èÌ̤ÎÃæ¤Ç¡¢ÆÃÄê¤Î¾ì")
@@ -114,11 +175,10 @@
   (garbage-collect))
 
 
-;;; ------------------------------------------------------------------
-;;; Crashes in debug version only
-;;; Fatal error: assertion failed, file src/objects.h, line 149,
-;;; RECORD_TYPEP (_obj, lrecord_font_instance) || MARKED_RECORD_P (_obj)
-(defbug 3
+(defbug 8 current
+  "Crashes in debug version only
+Fatal error: assertion failed, file src/objects.h, line 149,
+RECORD_TYPEP (_obj, lrecord_font_instance) || MARKED_RECORD_P (_obj)"
   (let (glyph ext)
     (make-face 'adobe-symbol-face)
     (set-face-font
@@ -131,20 +191,47 @@
     (set-extent-property ext 'begin-glyph glyph)))
 
 
-;;; ------------------------------------------------------------------
-;;; (maybe?) crash koi8
-;;; ACCL: Invalid command (c)
-;;; With debugging on, crashes as follows:
-;;; Fatal error: assertion failed, file src/lisp.h, line 1227, INTP (obj)
-(defbug 5
+(defbug 7 current
+  "(maybe?) crash koi8
+ACCL: Invalid command (c)
+With debugging on, crashes as follows:
+Fatal error: assertion failed, file src/lisp.h, line 1227, INTP (obj)"
   ;;(load "cyrillic")
   ;;(load "cyrillic-hooks")
   (princ (decode-coding-string "\xe1" 'koi8)))
 
 
-;;; ------------------------------------------------------------------
-;;; Completely Uninterruptible hang in re-search-backward (Was: java-mode)
-(defbug 6
+(defbug 6 current
+  "regexp crash
+This doesn't crash for me. -sb"
+  (string-match "\\(\\s-\\|$\\)" "å"))
+
+
+(defbug 5 legacy
+  "`subst-char-in-region' moves point."
+  (interactive)
+  (with-temp-buffer
+    (insert "abc")
+    (forward-char -1)
+    (subst-char-in-region 1 4 ?b ?\344)
+    (if (not (= (point) 3))
+	(message "Bug!  point should equal 3 but is %d" (point)))))
+
+
+(defbug 4 legacy
+  "Infinite recursion crash - Segmentation Fault"
+  (switch-to-buffer bug-buffer)
+  (insert "abcdefg")
+  (setq e (make-extent 1 4))
+  (set-extent-property e 'face 'bold)
+  (set-extent-property e 'duplicable t)
+  (set-extent-property e 'replicating t)
+  (insert (buffer-string))
+  (delete-region 8 9))
+
+
+(defbug 3 current
+  "Completely Uninterruptible hang in re-search-backward (Was: java-mode)"
   (switch-to-buffer bug-buffer)
   (insert "{
 public static void main(String[] args) throws java.io.IOException
@@ -159,62 +246,32 @@
    "^\\s(\\|\\(^[ \t]*\\(\\(\\(public\\|protected\\|static\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f]*\\)+\\)?\\s-*\\)\\s("))
 
 
-;;; ------------------------------------------------------------------
-;;; regexp crash
-;; This doesn't crash for me. -sb
-(defbug 7
-  (string-match "\\(\\s-\\|$\\)" "å"))
-
-  
-;;;; -------------------------------------------------------------------
-;;;; Bugs below this line have been fixed.
-;;;; Keep these for regression testing
-;;;; -------------------------------------------------------------------
+(defbug 2 legacy
+  "crash popup frames
+FIXED
+#### This bug is not understood, and may be incomplete.  See source."
+  (lambda ()
+    (let ((f (selected-frame)))
+      (make-frame `(popup ,(selected-frame)))
+      (make-frame)
+      (sit-for 0)
+      (delete-frame f)
+      ;; #### Check whether this is needed.
+      ;; (save-buffers-kill-emacs5)
+      )))
 
 
-;;; ------------------------------------------------------------------
-;;; Infinite recursion crash - Segmentation Fault
-(defbug 4
-  (switch-to-buffer bug-buffer)
-  (insert "abcdefg")
-  (setq e (make-extent 1 4))
-  (set-extent-property e 'face 'bold)
-  (set-extent-property e 'duplicable t)
-  (set-extent-property e 'replicating t)
-  (insert (buffer-string))
-  (delete-region 8 9))
-
-(defbug 5
-  (interactive)
-  (with-temp-buffer
-    (insert "abc")
-    (forward-char -1)
-    (subst-char-in-region 1 4 ?b ?\344)
-    (if (not (= (point) 3))
-	(message "Bug!  point should equal 3 but is %d" (point)))))
-
-;;; crash popup frames FIXED
-;; defbug 8
-;;(global-set-key
-;; [(alt meta control f12)]
-;; (lambda ()
-;;   (interactive)
-;;   (let ((f (selected-frame)))
-;;     (make-frame `(popup ,(selected-frame)))
-;;     (make-frame)
-;;     (sit-for 0)
-;;     (delete-frame f)
-;;     (save-buffers-kill-emacs))))
-
-;;; crash on delete-frame-hook - FIXED!
-;; defbug 9
-;;(global-set-key
-;; [(alt meta control f10)]
-;; (lambda ()
-;;   (interactive)
-;;   (setq delete-frame-hook
-;;         (lambda (frame)
-;;           (select-frame frame)
-;;         (kill-buffer (window-buffer (frame-selected-window frame)))))))
+(defbug 1 legacy
+  "crash on delete-frame-hook
+FIXED!
+#### This bug is not understood, and seems to be incomplete.  See source."
+  (lambda ()
+    ;; #### Should this be add-hook instead of setq?
+    (setq delete-frame-hook
+	  (lambda (frame)
+	    (select-frame frame)
+	    (kill-buffer (window-buffer (frame-selected-window frame)))
+	    ;; #### Do we need to delete a frame here or something?
+	    ))))
 
 ;;; reproduce-bugs.el ends here