Mercurial > hg > xemacs-beta

--- a/CHANGES-beta	Mon Aug 13 11:07:11 2007 +0200
+++ b/CHANGES-beta	Mon Aug 13 11:07:39 2007 +0200
@@ -1,5 +1,14 @@
 							-*- indented-text -*-
+to 21.2 beta6 "Apollo"
+-- mswindows compile fixes from Martin Buchholz, Andy Piper, Greg
+   Klanderman and Adrian Aichner
+-- Synch with XEmacs 21.0.60
+-- mega-patch fixes from Martin Buchholz
+-- md5 fixes and testsuite from Hrvoje Niksic
+-- database fix from Hrvoje Niksic
+
 to 21.2 beta5 "Aphrodite"
+-- synch with XEmacs 21.0.58
 -- bytecode interpreter rewritten
 -- byte compiler fixes
 -- hash table implementation rewritten
--- a/ChangeLog	Mon Aug 13 11:07:11 2007 +0200
+++ b/ChangeLog	Mon Aug 13 11:07:39 2007 +0200
@@ -1,3 +1,7 @@
+1998-12-16  Andy Piper  <andy@xemacs.org>
+
+	* XEmacs 21.2.6 is released
+
 1998-12-05  XEmacs Build Bot <builds@cvs.xemacs.org>

 	* XEmacs 21.2.5 is released
--- a/Makefile.in.in	Mon Aug 13 11:07:11 2007 +0200
+++ b/Makefile.in.in	Mon Aug 13 11:07:39 2007 +0200
@@ -534,11 +534,8 @@
 ##      distribution.
 top_distclean=\
 	$(RM) config.status config.log config-tmp-* build-install Installation ; \
-	for d in src lib-src lwlib dynodump ; do \
-	  $(RM) $$d/Makefile $$d/Makefile.in ; \
-	done ; \
-	$(RM) core .sbinit Makefile Makefile.in lock/*; \
-	$(RM) lisp/finder-inf.el* Installation.el Installation.elc; \
+	$(RM) core .sbinit lock/* GNUmakefile Makefile Makefile.in ; \
+	$(RM) lisp/finder-inf.el* Installation.el Installation.elc ; \
 	$(RM) packages mule-packages site-lisp

 distclean: FRC.distclean
--- a/PROBLEMS	Mon Aug 13 11:07:11 2007 +0200
+++ b/PROBLEMS	Mon Aug 13 11:07:39 2007 +0200
@@ -30,6 +30,11 @@
 ===============================

 ** General
+*** egcs-1.1
+
+There have been reports of egcs-1.1 not compiling XEmacs correctly on
+Alpha Linux.  There have also been reports that egcs-1.0.3a is O.K.
+
 *** Don't use -O2 with gcc 2.7.2 under Intel/XXX without also using
 `-fno-strength-reduce'.
--- a/configure.in	Mon Aug 13 11:07:11 2007 +0200
+++ b/configure.in	Mon Aug 13 11:07:39 2007 +0200
@@ -3668,7 +3668,7 @@
       done ) ;;
    * ) test -d "$dir" || mkdir "$dir" ;;
   esac
-  XE_SPACE(SUBDIR_MAKEFILES, $SUBDIR_MAKEFILES $dir/Makefile)
+  XE_SPACE(SUBDIR_MAKEFILES, $SUBDIR_MAKEFILES $dir/Makefile $dir/GNUmakefile)
   XE_SPACE(internal_makefile_list, $internal_makefile_list $dir/Makefile.in)
 done
 AC_SUBST(INSTALL_ARCH_DEP_SUBDIR)
--- a/dynodump/Makefile.in.in	Mon Aug 13 11:07:11 2007 +0200
+++ b/dynodump/Makefile.in.in	Mon Aug 13 11:07:39 2007 +0200
@@ -80,7 +80,7 @@
 clean: mostlyclean
 	$(RM) *.so *.so.1
 distclean: clean
-	$(RM) Makefile Makefile.in TAGS
+	$(RM) GNUmakefile Makefile Makefile.in TAGS
 realclean: distclean
 extraclean: realclean
 	$(RM) *~ \#*
--- a/lib-src/ChangeLog	Mon Aug 13 11:07:11 2007 +0200
+++ b/lib-src/ChangeLog	Mon Aug 13 11:07:39 2007 +0200
@@ -1,3 +1,7 @@
+1998-12-16  Andy Piper  <andy@xemacs.org>
+
+	* XEmacs 21.2.6 is released
+
 1998-12-05  XEmacs Build Bot <builds@cvs.xemacs.org>

 	* XEmacs 21.2.5 is released
--- a/lib-src/Makefile.in.in	Mon Aug 13 11:07:11 2007 +0200
+++ b/lib-src/Makefile.in.in	Mon Aug 13 11:07:39 2007 +0200
@@ -230,7 +230,7 @@
 	$(RM) ${INSTALLABLES} ${UTILITIES} *.exe
 distclean: clean
 	$(RM) DOC *.tab.c *.tab.h aixcc.c TAGS
-	$(RM) Makefile Makefile.in blessmail config.values
+	$(RM) GNUmakefile Makefile Makefile.in blessmail config.values
 realclean: distclean
 extraclean: distclean
 	$(RM) *~ \#*
--- a/lisp/ChangeLog	Mon Aug 13 11:07:11 2007 +0200
+++ b/lisp/ChangeLog	Mon Aug 13 11:07:39 2007 +0200
@@ -1,3 +1,48 @@
+1998-12-16  Andy Piper  <andy@xemacs.org>
+
+	* XEmacs 21.2.6 is released
+
+1998-11-30  Hrvoje Niksic  <hniksic@srce.hr>
+
+	* cus-dep.el (Custom-make-dependencies): Be smarter about trapping
+	errors.
+
+1998-12-04  Hrvoje Niksic  <hniksic@srce.hr>
+
+	* wid-edit.el (widget-echo-this-extent): Set
+	help-echo-owns-message to t.
+
+1998-11-30  Greg Klanderman  <greg@alphatech.com>
+
+	* package-get.el (package-get-download-menu): use toggles for
+	  each site in the download site menu.
+
+1998-12-01  Jan Vroonhof <vroonhof@math.ethz.ch>
+
+	* package-get.el (package-get): If we cannot find a package
+	  because package-get-remote is not set, give a more helpful
+	  error message.
+
+1998-11-30  Greg Klanderman  <greg@alphatech.com>
+
+	* package-get.el (package-get-remote-filename): use an EFS path
+	with user anonymous if no user is specified.
+
+1998-12-10  Jan Vroonhof  <vroonhof@math.ethz.ch>
+
+	* faces.el (face-spec-set): Re-init fallfacks for default after
+	calling reset-face on the default face.
+
+1998-12-10  Jan Vroonhof  <vroonhof@math.ethz.ch>
+
+	* package-admin.el (package-admin-default-install-function):
+	Behave as advertised.  Make sure the pkg-dir is proper for
+	default-directory.
+	(package-admin-add-binary-package): Make sure the pkg-dir is
+	proper for default-directory.
+	(package-admin-install-function-mswindows): Make sure the pkg-dir
+	is proper for default-directory.
+
 1998-12-05  XEmacs Build Bot <builds@cvs.xemacs.org>

 	* XEmacs 21.2.5 is released
--- a/lisp/cus-dep.el	Mon Aug 13 11:07:11 2007 +0200
+++ b/lisp/cus-dep.el	Mon Aug 13 11:07:39 2007 +0200
@@ -131,15 +131,21 @@
 			     (file-name-nondirectory file))))
 		  ;; Search for defcustom/defface/defgroup
 		  ;; expressions, and evaluate them.
-		  (ignore-errors
-		    (while (re-search-forward
-			    "^(defcustom\\|^(defface\\|^(defgroup"
-			    nil t)
-		      (beginning-of-line)
-		      (let ((expr (read (current-buffer))))
-			(eval expr)
-			;; Hash the file of the affected symbol.
-			(setf (gethash (nth 1 expr) hash) name)))))))
+		  (while (re-search-forward
+			  "^(defcustom\\|^(defface\\|^(defgroup"
+			  nil t)
+		    (beginning-of-line)
+		    (let ((expr (read (current-buffer))))
+		      ;; We need to ignore errors here, so that
+		      ;; defcustoms with :set don't bug out.  Of
+		      ;; course, their values will not be assigned in
+		      ;; case of errors, but their `custom-group'
+		      ;; properties will by that time be in place, and
+		      ;; that's all we care about.
+		      (ignore-errors
+			(eval expr))
+		      ;; Hash the file of the affected symbol.
+		      (setf (gethash (nth 1 expr) hash) name))))))
 	    (cond
 	     ((zerop (hash-table-count hash))
 	      (princ "(No customization dependencies")
--- a/lisp/faces.el	Mon Aug 13 11:07:11 2007 +0200
+++ b/lisp/faces.el	Mon Aug 13 11:07:39 2007 +0200
@@ -1209,6 +1209,8 @@
 	(init-face-from-resources face frame))
     (let ((frames (relevant-custom-frames)))
       (reset-face face)
+      (if (and (eq 'default face) (featurep 'x))
+	  (x-init-global-faces))
       (face-display-set face spec)
       (while frames
 	(face-display-set face spec (car frames))
--- a/lisp/package-admin.el	Mon Aug 13 11:07:11 2007 +0200
+++ b/lisp/package-admin.el	Mon Aug 13 11:07:39 2007 +0200
@@ -123,16 +123,20 @@

 (defun package-admin-install-function-mswindows (file pkg-dir buf)
   "Install function for mswindows"
-  (let ( (default-directory pkg-dir) )
-    (call-process "djtar" nil buf t "-x" file)
-    ))
+  (let ((default-directory (file-name-as-directory pkg-dir)))
+    (unless (file-directory-p default-directory)
+      (make-directory default-directory t))
+    (call-process "djtar" nil buf t "-x" file)))

 (defun package-admin-default-install-function (file pkg-dir buf)
   "Default function to install a package.
 Install package FILENAME into directory PKG-DIR, with any messages output
 to buffer BUF."
-  (let (filename)
-    (setq filename (expand-file-name file pkg-dir))
+  (let* ((pkg-dir (file-name-as-directory pkg-dir))
+	 (default-directory pkg-dir)
+	 (filename (expand-file-name file)))
+    (unless (file-directory-p pkg-dir)
+      (make-directory pkg-dir t))
     ;; Don't assume GNU tar.
     (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf)
 	0
@@ -323,7 +327,8 @@
     ;; Insure that the current directory doesn't change
     (save-excursion
       (set-buffer buf)
-      (setq default-directory pkg-dir)
+      ;; This is not really needed
+      (setq default-directory (file-name-as-directory pkg-dir))
       (setq case-fold-search t)
       (buffer-disable-undo)
       (goto-char (setq start (point-max)))
--- a/lisp/package-get.el	Mon Aug 13 11:07:11 2007 +0200
+++ b/lisp/package-get.el	Mon Aug 13 11:07:39 2007 +0200
@@ -260,7 +260,10 @@
   (mapcar (lambda (site)
             (vector (car site)
                     `(push (quote ,(cdr site))
-                           package-get-remote)))
+                           package-get-remote)
+                    :style 'toggle
+                    :selected `(member (quote ,(cdr site))
+                                       package-get-remote)))
           package-get-download-sites))

 ;;;###autoload
@@ -702,8 +705,10 @@
 	 (package-status t)
 	 filenames full-package-filename)
     (if (null this-package)
-	(error "Couldn't find package %s with version %s"
-	       package version))
+	(if package-get-remote
+	    (error "Couldn't find package %s with version %s"
+		   package version)
+	  (error "No download sites or local package locations specified.")))
     (if (null base-filename)
 	(error "No filename associated with package %s, version %s"
 	       package version))
@@ -804,7 +809,10 @@

       (if (or (not full-package-filename)
 	      (not (file-exists-p full-package-filename)))
-	  (error "Unable to find file %s" base-filename))
+	  (if package-get-remote
+	      (error "Unable to find file %s" base-filename)
+	    (error
+	     "No download sites or local package locations specified.")))
       ;; Validate the md5 checksum
       ;; Doing it with XEmacs removes the need for an external md5 program
       (message "Validating checksum for `%s'..." package) (sit-for 0)
@@ -937,7 +945,9 @@
   (if (efs-ftp-path filename)
       filename
     (let ((dir (cadr search)))
-      (concat "/"
+      (concat (if (string-match "@" (car search))
+		  "/"
+		"/anonymous@")
 	      (car search) ":"
 	      (if (string-match "/$" dir)
 		  dir
--- a/lisp/wid-edit.el	Mon Aug 13 11:07:11 2007 +0200
+++ b/lisp/wid-edit.el	Mon Aug 13 11:07:39 2007 +0200
@@ -302,6 +302,7 @@
     (and (functionp help-echo)
 	 (setq help-echo (funcall help-echo widget)))
     (when (stringp help-echo)
+      (setq help-echo-owns-message t)
       (display-message 'help-echo help-echo))))

 (defsubst widget-handle-help-echo (extent help-echo)
--- a/lwlib/Makefile.in.in	Mon Aug 13 11:07:11 2007 +0200
+++ b/lwlib/Makefile.in.in	Mon Aug 13 11:07:39 2007 +0200
@@ -86,7 +86,7 @@
 	$(RM) liblw.a liblw_pure_*.a *.o *.i core
 clean: mostlyclean
 distclean: clean
-	$(RM) Makefile Makefile.in config.h TAGS
+	$(RM) GNUmakefile Makefile Makefile.in config.h TAGS
 realclean: distclean
 extraclean: distclean
 	$(RM) *~ \#*
--- a/man/ChangeLog	Mon Aug 13 11:07:11 2007 +0200
+++ b/man/ChangeLog	Mon Aug 13 11:07:39 2007 +0200
@@ -1,3 +1,7 @@
+1998-12-16  Andy Piper  <andy@xemacs.org>
+
+	* XEmacs 21.2.6 is released
+
 1998-12-05  XEmacs Build Bot <builds@cvs.xemacs.org>

 	* XEmacs 21.2.5 is released
--- a/nt/ChangeLog	Mon Aug 13 11:07:11 2007 +0200
+++ b/nt/ChangeLog	Mon Aug 13 11:07:39 2007 +0200
@@ -1,3 +1,37 @@
+1998-12-16  Andy Piper  <andy@xemacs.org>
+
+	* XEmacs 21.2.6 is released
+
+1998-12-11  Adrian Aichner  <aichner@ecf.teradyne.com>
+
+	* xemacs.mak (DOC_SRC2): CLASH_DETECTION is not supported under
+ 	native Windows NT.  Therefore src\filelock.c is not to be
+ 	compiled.
+	(TEMACS_OBJS): Consequently, don't link in $(OUTDIR)\filelock.obj.
+
+1998-12-10  Jonathan Harris  <jhar@tardis.ed.ac.uk>
+
+	* xemacs.mak ($(OUTDIR)\alloc.obj): add a dependency on
+ 	puresize-adjust.h to avoid infinite recursion.
+
+1998-12-09  Andy Piper  <andy@xemacs.org>
+
+	* config.h: remove clash detection stuff.
+
+1998-12-07  Martin Buchholz  <martin@xemacs.org>
+
+	* xemacs.mak (TEMACS_OBJS):
+	(DOC_SRC4):
+	- Remove pure.c, pure.obj
+
+1998-11-04  Adrian Aichner  <aichner@ecf.teradyne.com>
+
+	* xemacs.mak: Creating minimal versions of Installation,
+ 	Installation.el, and config.values to make
+	(describe-installation) and (config-value ...) work in Windows NT
+ 	native builds.  Incorporating rule for movemail.exe courtesy of
+ 	Andy Piper.
+
 1998-12-05  XEmacs Build Bot <builds@cvs.xemacs.org>

 	* XEmacs 21.2.5 is released
--- a/nt/config.h	Mon Aug 13 11:07:11 2007 +0200
+++ b/nt/config.h	Mon Aug 13 11:07:39 2007 +0200
@@ -175,10 +175,6 @@

 #define HAVE_LONG_FILE_NAMES

-#ifdef HAVE_LONG_FILE_NAMES
-#define CLASH_DETECTION
-#endif
-
 #undef HAVE_LIBKSTAT
 #undef HAVE_LIBINTL
 #undef HAVE_LIBDNET
--- a/nt/xemacs.mak	Mon Aug 13 11:07:11 2007 +0200
+++ b/nt/xemacs.mak	Mon Aug 13 11:07:39 2007 +0200
@@ -219,7 +219,7 @@
 !if [set CONF_REPORT_ALREADY_PRINTED=1]
 !endif
 !message ------------------------------------------------
-!message Configured for "$(EMACS_CONFIGURATION)".
+!message XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename) configured for "$(EMACS_CONFIGURATION)".
 !message
 !message Installation directory is "$(INSTALL_DIR)".
 !message Package path is $(PATH_PACKAGEPATH).
@@ -398,6 +398,47 @@

 OUTDIR=obj

+#
+# Creating simplified versions of Installation and Installation.el
+#
+# Some values cannot be written on the same line with
+# their key, since they cannot be put inside an echo command.
+# Macro substitution (:"=\", :\=\\) can be performed on values in order
+# to create a legal string in LISP for Installation.el.
+#
+!if [echo OS: $(OS)>Installation] ||\
+[echo XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename:"=\") configured for ^`$(EMACS_CONFIGURATION)^'.>>Installation] ||\
+[echo Where should the build process find the source code?>>Installation] ||\
+[echo $(MAKEDIR:\=\\)>>Installation]
+!endif
+# Compiler Information
+!if defined(CCV) &&\
+[echo What compiler should XEmacs be built with?>>Installation] &&\
+[echo $(CCV)>>Installation]
+!endif
+# Window System Information
+!if [echo What window system should XEmacs use?>>Installation]
+!endif
+!if (defined (HAVE_X) && $(HAVE_X) == 1)
+!if [echo X11>>Installation]
+!endif
+!endif
+!if (defined (HAVE_MSW) && $(HAVE_MSW) == 1)
+!if [echo MS Windows>>Installation]
+!endif
+!endif
+!if (!defined (HAVE_MSW) && !defined (HAVE_X))
+!if [echo Please specify at least one HAVE_MSW^=1 and^/or HAVE_X^=1>>Installation]
+!endif
+!endif
+# Creation of Installation.el
+!if [type Installation] ||\
+[echo (setq Installation-string ^">Installation.el] ||\
+[type Installation >>Installation.el] ||\
+[echo ^")>>Installation.el]
+!endif
+
+
 #------------------------------------------------------------------------------

 default: $(OUTDIR)\nul all
@@ -430,6 +471,29 @@
 LIB_SRC = $(XEMACS)\lib-src
 LIB_SRC_DEFINES = -DHAVE_CONFIG_H -DWIN32 -DWINDOWSNT

+#
+# Creating config.values to be used by config.el
+#
+CONFIG_VALUES = $(LIB_SRC)\config.values
+!if [echo Creating $(CONFIG_VALUES) && echo ;;; Do not edit this file!>$(CONFIG_VALUES)]
+!endif
+# MAKEDIR has to be made into a string.
+!if [echo blddir>>$(CONFIG_VALUES) && echo ^"$(MAKEDIR:\=\\)\\..^">>$(CONFIG_VALUES)]
+!endif
+!if [echo CC>>$(CONFIG_VALUES) && echo ^"$(CC:\=\\)^">>$(CONFIG_VALUES)]
+!endif
+!if [echo CFLAGS>>$(CONFIG_VALUES) && echo ^"$(CFLAGS:\=\\)^">>$(CONFIG_VALUES)]
+!endif
+!if [echo CPP>>$(CONFIG_VALUES) && echo ^"$(CPP:\=\\)^">>$(CONFIG_VALUES)]
+!endif
+!if [echo CPPFLAGS>>$(CONFIG_VALUES) && echo ^"$(CPPFLAGS:\=\\)^">>$(CONFIG_VALUES)]
+!endif
+!if [echo LISPDIR>>$(CONFIG_VALUES) && echo ^"$(MAKEDIR:\=\\)\\$(LISP:\=\\)^">>$(CONFIG_VALUES)]
+!endif
+# PATH_PACKAGEPATH is already a quoted string.
+!if [echo PACKAGE_PATH>>$(CONFIG_VALUES) && echo $(PATH_PACKAGEPATH)>>$(CONFIG_VALUES)]
+!endif
+
 # Inferred rule
 {$(LIB_SRC)}.c{$(LIB_SRC)}.exe :
 	@cd $(LIB_SRC)
@@ -439,7 +503,7 @@
 # Individual dependencies
 ETAGS_DEPS = $(LIB_SRC)/getopt.c $(LIB_SRC)/getopt1.c $(LIB_SRC)/../src/regex.c
 $(LIB_SRC)/etags.exe : $(LIB_SRC)/etags.c $(ETAGS_DEPS)
-$(LIB_SRC)/movemail.exe: $(LIB_SRC)/movemail.c $(ETAGS_DEPS)
+$(LIB_SRC)/movemail.exe: $(LIB_SRC)/movemail.c $(LIB_SRC)/pop.c $(ETAGS_DEPS)

 LIB_SRC_TOOLS = \
 	$(LIB_SRC)/make-docfile.exe	\
@@ -558,7 +622,6 @@
  $(XEMACS)\src\faces.c \
  $(XEMACS)\src\file-coding.c \
  $(XEMACS)\src\fileio.c \
- $(XEMACS)\src\filelock.c \
  $(XEMACS)\src\filemode.c \
  $(XEMACS)\src\floatfns.c \
  $(XEMACS)\src\fns.c
@@ -596,7 +659,6 @@
  $(XEMACS)\src\process.c \
  $(XEMACS)\src\process-nt.c \
  $(XEMACS)\src\profile.c \
- $(XEMACS)\src\pure.c \
  $(XEMACS)\src\rangetab.c \
  $(XEMACS)\src\realpath.c \
  $(XEMACS)\src\redisplay-output.c \
@@ -803,7 +865,6 @@
 	$(OUTDIR)\faces.obj \
 	$(OUTDIR)\file-coding.obj \
 	$(OUTDIR)\fileio.obj \
-	$(OUTDIR)\filelock.obj \
 	$(OUTDIR)\filemode.obj \
 	$(OUTDIR)\floatfns.obj \
 	$(OUTDIR)\fns.obj \
@@ -839,7 +900,6 @@
 	$(OUTDIR)\process.obj \
 	$(OUTDIR)\process-nt.obj \
 	$(OUTDIR)\profile.obj \
-	$(OUTDIR)\pure.obj \
 	$(OUTDIR)\rangetab.obj \
 	$(OUTDIR)\realpath.obj \
 	$(OUTDIR)\redisplay-output.obj \
@@ -877,7 +937,7 @@
 $(OUTDIR)\TransientEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c
 	$(CCV) $(TEMACS_FLAGS) -DDEFINE_TRANSIENT_EMACS_SHELL $** -Fo$@

-$(OUTDIR)\pure.obj: $(TEMACS_SRC)\pure.c $(TEMACS_SRC)\puresize-adjust.h
+$(OUTDIR)\alloc.obj: $(TEMACS_SRC)\alloc.c $(TEMACS_SRC)\puresize-adjust.h

 #$(TEMACS_SRC)\Emacs.ad.h: $(XEMACS)\etc\Emacs.ad
 #	!"sed -f ad2c.sed < $(XEMACS)\etc\Emacs.ad > $(TEMACS_SRC)\Emacs.ad.h"
@@ -951,6 +1011,7 @@
 	@del "$(INSTALL_DIR)\lock\README"
 	@xcopy /q $(LIB_SRC)\*.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)\"
 	@copy $(LIB_SRC)\DOC "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)"
+	@copy $(CONFIG_VALUES) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)"
 	@copy $(XEMACS)\src\xemacs.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)"
 	@copy $(RUNEMACS) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)"
 	@xcopy /e /q $(XEMACS)\etc  "$(INSTALL_DIR)\etc\"
@@ -985,6 +1046,7 @@
 	del *.orig
 	del *.rej
 	del *.exe
+	del $(CONFIG_VALUES)
 	cd $(LISP)
 	-del /s /q *.bak *.elc *.orig *.rej
--- a/src/ChangeLog	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/ChangeLog	Mon Aug 13 11:07:39 2007 +0200
@@ -1,3 +1,115 @@
+1998-12-16  Andy Piper  <andy@xemacs.org>
+
+	* XEmacs 21.2.6 is released
+
+1998-12-08  Hrvoje Niksic  <hniksic@srce.hr>
+
+	* md5.c (Fmd5): Correctly initiate string input stream.
+
+	* Makefile.in.in (tests): Add md5-tests.el.
+
+1998-12-06  Martin Buchholz  <martin@xemacs.org>
+
+	* lisp.h:
+	* alloc.c (make_vector): remove travesty
+	(Fmake_vector):
+	(make_pure_vector):
+	(pure_cons):
+	(make_bit_vector_internal):
+	(make_bit_vector):
+	(make_bit_vector_from_byte_vector):
+	(Fmake_bit_vector):
+	- make vector_equal a little faster.
+	- Don't use variable name `new'.
+	- Use size_t instead of EMACS_INT.
+	- usual Martin-style pointless bit-twiddling.
+
+	* fns.c (mapcar1):
+	(Fmapconcat):
+	(Fmapcar):
+	(Fmapvector):
+	Make mapcar faster.  In particular, make
+	  (mapc #'identity long-string)
+	MUCH faster under Mule.
+	* tests/automated/lisp-tests.el: Test 'em!
+
+1998-12-06  Martin Buchholz  <martin@xemacs.org>
+
+	* bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded
+	bytecode.
+
+1998-12-13  Martin Buchholz  <martin@xemacs.org>
+
+	* console-msw.c: Function definitions follow coding standards
+	- This prevents e.g. find-tag on Lisp_Event finding DEVENT
+
+1998-12-11  Martin Buchholz  <martin@xemacs.org>
+
+	* events.h (struct timeout_data):
+	* event-tty.c (tty_timeout_to_emacs_event):
+	* event-msw.c (mswindows_wm_timer_callback):
+	* event-Xt.c (Xt_timeout_to_emacs_event):
+	* event-msw.c (mswindows_cancel_dispatch_event):
+	Make sure Lisp_Objects inside events are initialized to Qnil, not
+	Qnull_pointer, which is now illegal.
+
+1998-12-10  Martin Buchholz  <martin@xemacs.org>
+
+	* lisp.h: Fix up prototypes to match alloc.c
+
+1998-12-09  Andy Piper  <andy@xemacs.org>
+
+	* glyphs-msw.c (init_image_instance_from_xbm_inline): don't use
+ 	XSETINT for assigning lisp objects.
+
+1998-12-07  Martin Buchholz  <martin@xemacs.org>
+
+	* opaque.h:
+	* console-msw.c (DHEADER):
+	(DOPAQUE_DATA):
+	(DEVENT):
+	(DCONS):
+	(DCONSCDR):
+	(DSTRING):
+	(DVECTOR):
+	(DSYMBOL):
+	(DSYMNAME):
+	- max_align_t should not be visible to the user of the
+	  XOPAQUE_DATA macro.
+	- use Bufbyte instead of char
+	- parens around (FOOP (obj)) are always redundant.
+	  If they were necessary, we should fix the macro instead.
+	- Always use string_data(foo) instead of foo->data.
+
+1998-12-07  Martin Buchholz  <martin@xemacs.org>
+
+	* sysdep.c (set_descriptor_non_blocking):
+	Since O_NONBLOCK is now always #defined, make use of fcntl
+	conditional on F_SETFL being defined.
+
+1998-12-09  Andy Piper  <andy@xemacs.org>
+
+	* menubar-msw.c (mswindows_handle_wm_command): add back in checks
+ 	that got removed in the merge
+
+1998-11-30  Greg Klanderman  <greg@alphatech.com>
+
+	* dired.c (vars_of_dired): bugfix for previous conditionalization
+	of user-name-completion on non- Windows NT.
+
+1998-12-08  Martin Buchholz  <martin@xemacs.org>
+
+	* windowsnt.h: Remove `support' for using index and rindex
+
+	* filelock.c (current_lock_owner):
+	- Change uses of index -> strchr, rindex -> strrchr
+
+1998-12-06  Martin Buchholz  <martin@xemacs.org>
+
+	* frame-msw.c (mswindows_init_frame_1):
+	- use make_lisp_hash_table, not Fmake_hash_table
+	- include elhash.h
+
 1998-12-05  XEmacs Build Bot <builds@cvs.xemacs.org>

 	* XEmacs 21.2.5 is released
--- a/src/Makefile.in.in	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/Makefile.in.in	Mon Aug 13 11:07:39 2007 +0200
@@ -350,7 +350,7 @@

 fastdump: temacs
 	@$(RM) ${PROGNAME} && touch SATISFIED
-	-${dumpp_temacs}
+	-${dump_temacs}
 	@if test -f ${PROGNAME}; then if test -f SATISFIED; then \
 		./${PROGNAME} -batch -vanilla -f list-load-path-shadows; fi; \
 		$(RM) SATISFIED; exit 0; fi; \
@@ -454,10 +454,11 @@
 ## We have automated tests!!
 testdir = ${srcdir}/../tests/automated
 tests   = \
-	${testdir}/hash-table-tests.el \
-	${testdir}/lisp-tests.el \
-	${testdir}/database-tests.el \
-	${testdir}/byte-compiler-tests.el
+	${testdir}/hash-table-tests.el    \
+	${testdir}/lisp-tests.el          \
+	${testdir}/database-tests.el      \
+	${testdir}/byte-compiler-tests.el \
+	${testdir}/md5-tests.el
 batch_test_emacs = -batch -l ${testdir}/test-harness.el -f batch-test-emacs ${tests}

 .PHONY: check check-temacs
@@ -692,7 +693,7 @@
 ## Do not use it on development directories!
 distclean: clean
 	$(RM) config.h paths.h Emacs.ad.h \
-	  Makefile Makefile.in GNUmakefile TAGS ${PROGNAME}.*
+	  GNUmakefile Makefile Makefile.in TAGS ${PROGNAME}.*
 realclean: distclean
 versionclean:
 	$(RM) ${PROGNAME} ${PROGNAME}.exe ${libsrc}DOC
--- a/src/alloc.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/alloc.c	Mon Aug 13 11:07:39 2007 +0200
@@ -65,7 +65,14 @@

 EXFUN (Fgarbage_collect, 0);

-/* #define GDB_SUCKS */
+/* Return the true size of a struct with a variable-length array field.  */
+#define STRETCHY_STRUCT_SIZEOF(stretchy_struct_type,		\
+			       stretchy_array_field,		\
+			       stretchy_array_length)		\
+  (offsetof (stretchy_struct_type, stretchy_array_field) +	\
+   (offsetof (stretchy_struct_type, stretchy_array_field[1]) -	\
+    offsetof (stretchy_struct_type, stretchy_array_field[0])) *	\
+   (stretchy_array_length))

 #if 0 /* this is _way_ too slow to be part of the standard debug options */
 #if defined(DEBUG_XEMACS) && defined(MULE)
@@ -1303,23 +1310,24 @@
 static size_t
 size_vector (CONST void *lheader)
 {
-  return offsetof (Lisp_Vector, contents[((Lisp_Vector *) lheader)->size]);
+  return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents,
+				 ((Lisp_Vector *) lheader)->size);
 }

 static int
 vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-  int indice;
   int len = XVECTOR_LENGTH (obj1);
   if (len != XVECTOR_LENGTH (obj2))
     return 0;
-  for (indice = 0; indice < len; indice++)
-    {
-      if (!internal_equal (XVECTOR_DATA (obj1) [indice],
-			   XVECTOR_DATA (obj2) [indice],
-			   depth + 1))
+
+  {
+    Lisp_Object *ptr1 = XVECTOR_DATA (obj1);
+    Lisp_Object *ptr2 = XVECTOR_DATA (obj2);
+    while (len--)
+      if (!internal_equal (*ptr1++, *ptr2++, depth + 1))
 	return 0;
-    }
+  }
   return 1;
 }

@@ -1339,7 +1347,7 @@
 make_vector_internal (size_t sizei)
 {
   /* no vector_next */
-  size_t sizem = offsetof (Lisp_Vector, contents[sizei]);
+  size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei);
   Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, lrecord_vector);

   p->size = sizei;
@@ -1355,7 +1363,7 @@
 make_vector_internal (size_t sizei)
 {
   /* + 1 to account for vector_next */
-  size_t sizem = offsetof (Lisp_Vector, contents[sizei+1]);
+  size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei+1);
   Lisp_Vector *p = (Lisp_Vector *) allocate_lisp_storage (sizem);

   INCREMENT_CONS_COUNTER (sizem, "vector");
@@ -1369,36 +1377,19 @@
 #endif /* ! LRECORD_VECTOR */

 Lisp_Object
-make_vector (EMACS_INT length, Lisp_Object init)
+make_vector (size_t length, Lisp_Object init)
 {
-  int elt;
-  Lisp_Object vector;
-  Lisp_Vector *p;
-
-  if (length < 0)
-    length = XINT (wrong_type_argument (Qnatnump, make_int (length)));
-
-  p = make_vector_internal (length);
-  XSETVECTOR (vector, p);
-
-#if 0
-  /* Initialize big arrays full of 0's quickly, for what that's worth */
+  Lisp_Vector *vecp = make_vector_internal (length);
+  Lisp_Object *p = vector_data (vecp);
+
+  while (length--)
+    *p++ = init;
+
   {
-    char *travesty = (char *) &init;
-    for (i = 1; i < sizeof (Lisp_Object); i++)
-    {
-      if (travesty[i] != travesty[0])
-        goto fill;
-    }
-    memset (vector_data (p), travesty[0], length * sizeof (Lisp_Object));
+    Lisp_Object vector;
+    XSETVECTOR (vector, vecp);
     return vector;
   }
- fill:
-#endif
-  for (elt = 0; elt < length; elt++)
-    vector_data(p)[elt] = init;
-
-  return vector;
 }

 DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
@@ -1407,7 +1398,7 @@
 */
        (length, init))
 {
-  CHECK_NATNUM (length);
+  CONCHECK_NATNUM (length);
   return make_vector (XINT (length), init);
 }

@@ -1417,15 +1408,17 @@
 */
        (int nargs, Lisp_Object *args))
 {
-  Lisp_Object vector;
-  int elt;
-  Lisp_Vector *p = make_vector_internal (nargs);
-
-  for (elt = 0; elt < nargs; elt++)
-    vector_data(p)[elt] = args[elt];
-
-  XSETVECTOR (vector, p);
-  return vector;
+  Lisp_Vector *vecp = make_vector_internal (nargs);
+  Lisp_Object *p = vector_data (vecp);
+
+  while (nargs--)
+    *p++ = *args++;
+
+  {
+    Lisp_Object vector;
+    XSETVECTOR (vector, vecp);
+    return vector;
+  }
 }

 Lisp_Object
@@ -1538,8 +1531,8 @@
 static struct Lisp_Bit_Vector *
 make_bit_vector_internal (size_t sizei)
 {
-  size_t sizem =
-    offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (sizei)]);
+  size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
+  size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, num_longs);
   Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem);
   set_lheader_implementation (&(p->lheader), lrecord_bit_vector);

@@ -1549,56 +1542,52 @@
   bit_vector_next   (p) = all_bit_vectors;
   /* make sure the extra bits in the last long are 0; the calling
      functions might not set them. */
-  p->bits[BIT_VECTOR_LONG_STORAGE (sizei) - 1] = 0;
+  p->bits[num_longs - 1] = 0;
   XSETBIT_VECTOR (all_bit_vectors, p);
   return p;
 }

 Lisp_Object
-make_bit_vector (EMACS_INT length, Lisp_Object init)
+make_bit_vector (size_t length, Lisp_Object init)
 {
-  Lisp_Object bit_vector;
-  struct Lisp_Bit_Vector *p;
-  EMACS_INT num_longs;
+  struct Lisp_Bit_Vector *p = make_bit_vector_internal (length);
+  size_t num_longs = BIT_VECTOR_LONG_STORAGE (length);

   CHECK_BIT (init);

-  num_longs = BIT_VECTOR_LONG_STORAGE (length);
-  p = make_bit_vector_internal (length);
-  XSETBIT_VECTOR (bit_vector, p);
-
   if (ZEROP (init))
     memset (p->bits, 0, num_longs * sizeof (long));
   else
     {
-      EMACS_INT bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
+      size_t bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
       memset (p->bits, ~0, num_longs * sizeof (long));
       /* But we have to make sure that the unused bits in the
-	 last integer are 0, so that equal/hash is easy. */
+	 last long are 0, so that equal/hash is easy. */
       if (bits_in_last)
 	p->bits[num_longs - 1] &= (1 << bits_in_last) - 1;
     }

-  return bit_vector;
+  {
+    Lisp_Object bit_vector;
+    XSETBIT_VECTOR (bit_vector, p);
+    return bit_vector;
+  }
 }

 Lisp_Object
-make_bit_vector_from_byte_vector (unsigned char *bytevec, EMACS_INT length)
+make_bit_vector_from_byte_vector (unsigned char *bytevec, size_t length)
 {
-  Lisp_Object bit_vector;
-  struct Lisp_Bit_Vector *p;
   int i;
-
-  if (length < 0)
-    length = XINT (wrong_type_argument (Qnatnump, make_int (length)));
-
-  p = make_bit_vector_internal (length);
-  XSETBIT_VECTOR (bit_vector, p);
+  Lisp_Bit_Vector *p = make_bit_vector_internal (length);

   for (i = 0; i < length; i++)
     set_bit_vector_bit (p, i, bytevec[i]);

-  return bit_vector;
+  {
+    Lisp_Object bit_vector;
+    XSETBIT_VECTOR (bit_vector, p);
+    return bit_vector;
+  }
 }

 DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
@@ -1618,20 +1607,20 @@
 */
        (int nargs, Lisp_Object *args))
 {
-  Lisp_Object bit_vector;
-  int elt;
-  struct Lisp_Bit_Vector *p;
-
-  for (elt = 0; elt < nargs; elt++)
-    CHECK_BIT (args[elt]);
-
-  p = make_bit_vector_internal (nargs);
-
-  for (elt = 0; elt < nargs; elt++)
-    set_bit_vector_bit (p, elt, !ZEROP (args[elt]));
-
-  XSETBIT_VECTOR (bit_vector, p);
-  return bit_vector;
+  int i;
+  Lisp_Bit_Vector *p = make_bit_vector_internal (nargs);
+
+  for (i = 0; i < nargs; i++)
+    {
+      CHECK_BIT (args[i]);
+      set_bit_vector_bit (p, i, !ZEROP (args[i]));
+    }
+
+  {
+    Lisp_Object bit_vector;
+    XSETBIT_VECTOR (bit_vector, p);
+    return bit_vector;
+  }
 }


@@ -2113,13 +2102,13 @@
   else
     {
       /* Make a new current string chars block */
-      struct string_chars_block *new = xnew (struct string_chars_block);
-
-      current_string_chars_block->next = new;
-      new->prev = current_string_chars_block;
-      new->next = 0;
-      current_string_chars_block = new;
-      new->pos = fullsize;
+      struct string_chars_block *new_scb = xnew (struct string_chars_block);
+
+      current_string_chars_block->next = new_scb;
+      new_scb->prev = current_string_chars_block;
+      new_scb->next = 0;
+      current_string_chars_block = new_scb;
+      new_scb->pos = fullsize;
       s_chars = (struct string_chars *)
 	current_string_chars_block->string_chars;
     }
@@ -2307,12 +2296,10 @@
 void
 set_string_char (struct Lisp_String *s, Charcount i, Emchar c)
 {
-  Bytecount oldlen, newlen;
   Bufbyte newstr[MAX_EMCHAR_LEN];
   Bytecount bytoff = charcount_to_bytecount (string_data (s), i);
-
-  oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1);
-  newlen = set_charptr_emchar (newstr, c);
+  Bytecount oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1);
+  Bytecount newlen = set_charptr_emchar (newstr, c);

   if (oldlen != newlen)
     resize_string (s, bytoff, newlen - oldlen);
@@ -2593,9 +2580,8 @@
 make_pure_string (CONST Bufbyte *data, Bytecount length,
 		  Lisp_Object plist, int no_need_to_copy_data)
 {
-  Lisp_Object new;
-  struct Lisp_String *s;
-  size_t size = sizeof (struct Lisp_String) +
+  Lisp_String *s;
+  size_t size = sizeof (Lisp_String) +
     (no_need_to_copy_data ? 0 : (length + 1)); /* + 1 for terminating 0 */
   size = ALIGN_SIZE (size, ALIGNOF (Lisp_Object));

@@ -2607,15 +2593,19 @@
 	{
 	  s = XSYMBOL (tem)->name;
 	  if (!PURIFIED (s)) abort ();
-	  XSETSTRING (new, s);
-	  return new;
+
+	  {
+	    Lisp_Object string;
+	    XSETSTRING (string, s);
+	    return string;
+	  }
 	}
     }

   if (!check_purespace (size))
     return make_string (data, length);

-  s = (struct Lisp_String *) (PUREBEG + pure_bytes_used);
+  s = (Lisp_String *) (PUREBEG + pure_bytes_used);
 #ifdef LRECORD_STRING
   set_lheader_implementation (&(s->lheader), lrecord_string);
 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
@@ -2629,7 +2619,7 @@
     }
   else
     {
-      set_string_data (s, (Bufbyte *) s + sizeof (struct Lisp_String));
+      set_string_data (s, (Bufbyte *) s + sizeof (Lisp_String));
       memcpy (string_data (s), data, length);
       set_string_byte (s, length, 0);
     }
@@ -2645,8 +2635,11 @@
   /* Do this after the official "completion" of the purecopying. */
   s->plist = Fpurecopy (plist);

-  XSETSTRING (new, s);
-  return new;
+  {
+    Lisp_Object string;
+    XSETSTRING (string, s);
+    return string;
+  }
 }


@@ -2668,26 +2661,29 @@
 Lisp_Object
 pure_cons (Lisp_Object car, Lisp_Object cdr)
 {
-  Lisp_Object new;
-  struct Lisp_Cons *c;
-
-  if (!check_purespace (sizeof (struct Lisp_Cons)))
+  Lisp_Cons *c;
+
+  if (!check_purespace (sizeof (Lisp_Cons)))
     return Fcons (Fpurecopy (car), Fpurecopy (cdr));

-  c = (struct Lisp_Cons *) (PUREBEG + pure_bytes_used);
+  c = (Lisp_Cons *) (PUREBEG + pure_bytes_used);
 #ifdef LRECORD_CONS
   set_lheader_implementation (&(c->lheader), lrecord_cons);
 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
   c->lheader.pure = 1;
 #endif
 #endif
-  pure_bytes_used += sizeof (struct Lisp_Cons);
-  bump_purestat (&purestat_cons, sizeof (struct Lisp_Cons));
+  pure_bytes_used += sizeof (Lisp_Cons);
+  bump_purestat (&purestat_cons, sizeof (Lisp_Cons));

   c->car = Fpurecopy (car);
   c->cdr = Fpurecopy (cdr);
-  XSETCONS (new, c);
-  return new;
+
+  {
+    Lisp_Object cons;
+    XSETCONS (cons, c);
+    return cons;
+  }
 }

 Lisp_Object
@@ -2756,9 +2752,8 @@
 Lisp_Object
 make_pure_vector (size_t len, Lisp_Object init)
 {
-  Lisp_Object new;
   Lisp_Vector *v;
-  size_t size = offsetof (Lisp_Vector, contents[len]);
+  size_t size = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len);

   init = Fpurecopy (init);

@@ -2780,8 +2775,11 @@
   for (size = 0; size < len; size++)
     v->contents[size] = init;

-  XSETVECTOR (new, v);
-  return new;
+  {
+    Lisp_Object vector;
+    XSETVECTOR (vector, v);
+    return vector;
+  }
 }

 #if 0
@@ -3338,7 +3336,7 @@
     }
 #ifndef LRECORD_VECTOR
   else if (VECTORP (obj))
-    return offsetof (Lisp_Vector, contents[XVECTOR_LENGTH (obj)]);
+    return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, XVECTOR_LENGTH (obj));
 #endif /* !LRECORD_VECTOR */

 #ifndef LRECORD_CONS
@@ -3523,7 +3521,8 @@
 	  v->size = len;
 	  total_size += len;
           total_storage +=
-	    MALLOC_OVERHEAD + offsetof (Lisp_Vector, contents[len + 1]);
+	    MALLOC_OVERHEAD +
+	    STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len + 1);
 	  num_used++;
 	  prev = &(vector_next (v));
 	  vector = *prev;
@@ -3563,8 +3562,9 @@
 	  UNMARK_RECORD_HEADER (&(v->lheader));
 	  total_size += len;
           total_storage +=
-	    MALLOC_OVERHEAD
-	    + offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (len)]);
+	    MALLOC_OVERHEAD +
+	    STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits,
+				    BIT_VECTOR_LONG_STORAGE (len));
 	  num_used++;
 	  prev = &(bit_vector_next (v));
 	  bit_vector = *prev;
--- a/src/bytecode.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/bytecode.c	Mon Aug 13 11:07:39 2007 +0200
@@ -2336,7 +2336,7 @@
   if (OPAQUEP (f->instructions) || STRINGP (f->instructions))
     return function;

-  if (CONSP (XCOMPILED_FUNCTION (function)->instructions))
+  if (CONSP (f->instructions))
     {
       Lisp_Object tem = read_doc_string (f->instructions);
       if (!CONSP (tem))
@@ -2346,8 +2346,8 @@
 	ebolify_bytecode_constants (XCDR (tem));
       /* VERY IMPORTANT to purecopy here!!!!!
 	 See load_force_doc_string_unwind. */
-      /* f->instructions = Fpurecopy (XCAR (tem)); */
-      f->constants = Fpurecopy (XCDR (tem));
+      f->instructions = Fpurecopy (XCAR (tem));
+      f->constants    = Fpurecopy (XCDR (tem));
       return function;
     }
   abort ();
--- a/src/console-msw.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/console-msw.c	Mon Aug 13 11:07:39 2007 +0200
@@ -84,49 +84,58 @@
  * Intended for use in the MSVC "Watch" window which doesn't like
  * the aborts that the error_check_foo() functions can make.
  */
-struct lrecord_header *DHEADER(Lisp_Object obj)
+struct lrecord_header *
+DHEADER (Lisp_Object obj)
 {
-  return (LRECORDP (obj)) ? XRECORD_LHEADER (obj) : NULL;
+  return LRECORDP (obj) ? XRECORD_LHEADER (obj) : NULL;
 }

-int *DOPAQUE_DATA (Lisp_Object obj)
+void *
+DOPAQUE_DATA (Lisp_Object obj)
 {
-  return (OPAQUEP (obj)) ? OPAQUE_DATA (XOPAQUE (obj)) : NULL;
+  return OPAQUEP (obj) ? OPAQUE_DATA (XOPAQUE (obj)) : NULL;
 }

-struct Lisp_Event *DEVENT(Lisp_Object obj)
+struct Lisp_Event *
+DEVENT (Lisp_Object obj)
 {
-  return (EVENTP (obj)) ? XEVENT (obj) : NULL;
+  return EVENTP (obj) ? XEVENT (obj) : NULL;
 }

-struct Lisp_Cons *DCONS(Lisp_Object obj)
+struct Lisp_Cons *
+DCONS (Lisp_Object obj)
 {
-  return (CONSP (obj)) ? XCONS (obj) : NULL;
+  return CONSP (obj) ? XCONS (obj) : NULL;
 }

-struct Lisp_Cons *DCONSCDR(Lisp_Object obj)
+struct Lisp_Cons *
+DCONSCDR (Lisp_Object obj)
 {
-  return ((CONSP (obj)) && (CONSP (XCDR (obj)))) ? XCONS (XCDR (obj)) : 0;
+  return (CONSP (obj) && CONSP (XCDR (obj))) ? XCONS (XCDR (obj)) : 0;
 }

-char *DSTRING(Lisp_Object obj)
+Bufbyte *
+DSTRING (Lisp_Object obj)
 {
-  return (STRINGP (obj)) ? XSTRING_DATA (obj) : NULL;
+  return STRINGP (obj) ? XSTRING_DATA (obj) : NULL;
 }

-struct Lisp_Vector *DVECTOR(Lisp_Object obj)
+struct Lisp_Vector *
+DVECTOR (Lisp_Object obj)
 {
-  return (VECTORP (obj)) ? XVECTOR (obj) : NULL;
+  return VECTORP (obj) ? XVECTOR (obj) : NULL;
 }

-struct Lisp_Symbol *DSYMBOL(Lisp_Object obj)
+struct Lisp_Symbol *
+DSYMBOL (Lisp_Object obj)
 {
-  return (SYMBOLP (obj)) ? XSYMBOL (obj) : NULL;
+  return SYMBOLP (obj) ? XSYMBOL (obj) : NULL;
 }

-char *DSYMNAME(Lisp_Object obj)
+Bufbyte *
+DSYMNAME (Lisp_Object obj)
 {
-  return (SYMBOLP (obj)) ? XSYMBOL (obj)->name->_data : NULL;
+  return SYMBOLP (obj) ? string_data (XSYMBOL (obj)->name) : NULL;
 }

 #endif
--- a/src/database.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/database.c	Mon Aug 13 11:07:39 2007 +0200
@@ -498,19 +498,21 @@
       call2 (func, key, val);
     }
 #else
-  DBC *dbcp;
+  {
+    DBC *dbcp;

-  status = dbp->cursor (dbp, NULL, &dbcp);
-  for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
-       status == 0;
-       status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
-    {
-      /* ### Needs mule-izing */
-      key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
-      val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
-      call2 (func, key, val);
-    }
-  dbcp->c_close (dbcp);
+    status = dbp->cursor (dbp, NULL, &dbcp);
+    for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST);
+	 status == 0;
+	 status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT))
+      {
+	/* ### Needs mule-izing */
+	key = make_string ((Bufbyte *) keydatum.data, keydatum.size);
+	val = make_string ((Bufbyte *) valdatum.data, valdatum.size);
+	call2 (func, key, val);
+      }
+    dbcp->c_close (dbcp);
+  }
 #endif /* DB_VERSION_MAJOR */
 }
--- a/src/dired.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/dired.c	Mon Aug 13 11:07:39 2007 +0200
@@ -956,7 +956,9 @@
 */ );
   Vcompletion_ignored_extensions = Qnil;

+#ifndef  WINDOWSNT
   user_cache = NULL;
   user_cache_len = 0;
   user_cache_max = 0;
+#endif
 }
--- a/src/event-Xt.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/event-Xt.c	Mon Aug 13 11:07:39 2007 +0200
@@ -1756,6 +1756,8 @@
   /* timeout events have nil as channel */
   emacs_event->timestamp  = 0; /* #### wrong!! */
   emacs_event->event.timeout.interval_id = timeout->id;
+  emacs_event->event.timeout.function = Qnil;
+  emacs_event->event.timeout.object = Qnil;
   Blocktype_free (the_Xt_timeout_blocktype, timeout);
 }
--- a/src/event-msw.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/event-msw.c	Mon Aug 13 11:07:39 2007 +0200
@@ -1446,6 +1446,8 @@
   event->timestamp = dwtime;
   event->event_type = timeout_event;
   event->event.timeout.interval_id = id_timer;
+  event->event.timeout.function = Qnil;
+  event->event.timeout.object = Qnil;

   mswindows_enqueue_dispatch_event (emacs_event);
 }
--- a/src/event-tty.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/event-tty.c	Mon Aug 13 11:07:39 2007 +0200
@@ -71,6 +71,8 @@
   emacs_event->timestamp  = 0; /* #### */
   emacs_event->event.timeout.interval_id =
     pop_low_level_timeout (&tty_timer_queue, 0);
+  emacs_event->event.timeout.function = Qnil;
+  emacs_event->event.timeout.object = Qnil;
 }
--- a/src/events.h	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/events.h	Mon Aug 13 11:07:39 2007 +0200
@@ -393,7 +393,8 @@
 {
   int		    interval_id;
   int		    id_number;
-  Lisp_Object	    function, object;
+  Lisp_Object	    function;
+  Lisp_Object	    object;
 };

 struct eval_data
--- a/src/filelock.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/filelock.c	Mon Aug 13 11:07:39 2007 +0200
@@ -157,9 +157,6 @@
 static int
 current_lock_owner (lock_info_type *owner, char *lfname)
 {
-#ifndef index
-  extern char *rindex (), *index ();
-#endif
   int o, p, len, ret;
   int local_owner = 0;
   char *at, *dot;
@@ -195,8 +192,8 @@

   /* Parse USER@HOST.PID.  If can't parse, return -1.  */
   /* The USER is everything before the first @.  */
-  at = index (lfinfo, '@');
-  dot = rindex (lfinfo, '.');
+  at = strchr (lfinfo, '@');
+  dot = strrchr (lfinfo, '.');
   if (!at || !dot) {
     xfree (lfinfo);
     return -1;
--- a/src/frame-msw.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/frame-msw.c	Mon Aug 13 11:07:39 2007 +0200
@@ -35,6 +35,7 @@
 #include "buffer.h"
 #include "console-msw.h"
 #include "glyphs-msw.h"
+#include "elhash.h"
 #include "events.h"
 #include "faces.h"
 #include "frame.h"
@@ -128,8 +129,8 @@
   FRAME_MSWINDOWS_DATA(f)->sizing = 0;
   FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil;
 #ifdef HAVE_TOOLBARS
-  FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) = Fmake_hash_table (make_int (50),
-							  Qequal);
+  FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) =
+    make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
 #endif

   /* Will initialize these in WM_SIZE handler. We cannot do it now,
--- a/src/glyphs-msw.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/glyphs-msw.c	Mon Aug 13 11:07:39 2007 +0200
@@ -1732,10 +1732,10 @@
 	if (NILP (background))
 	  background = pointer_bg;

-	XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii),
-		 find_keyword_in_vector (instantiator, Q_hotspot_x));
-	XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii),
-		 find_keyword_in_vector (instantiator, Q_hotspot_y));
+	IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) =
+	  find_keyword_in_vector (instantiator, Q_hotspot_x);
+	IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) =
+	  find_keyword_in_vector (instantiator, Q_hotspot_y);
 	IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground;
 	IMAGE_INSTANCE_PIXMAP_BG (ii) = background;
 	if (COLOR_INSTANCEP (foreground))
--- a/src/lisp.h	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/lisp.h	Mon Aug 13 11:07:39 2007 +0200
@@ -2160,12 +2160,12 @@
 /* Defined in alloc.c */
 void release_breathing_space (void);
 Lisp_Object noseeum_cons (Lisp_Object, Lisp_Object);
-Lisp_Object make_vector (EMACS_INT, Lisp_Object);
+Lisp_Object make_vector (size_t, Lisp_Object);
 Lisp_Object vector1 (Lisp_Object);
 Lisp_Object vector2 (Lisp_Object, Lisp_Object);
 Lisp_Object vector3 (Lisp_Object, Lisp_Object, Lisp_Object);
-Lisp_Object make_bit_vector (EMACS_INT, Lisp_Object);
-Lisp_Object make_bit_vector_from_byte_vector (unsigned char *, EMACS_INT);
+Lisp_Object make_bit_vector (size_t, Lisp_Object);
+Lisp_Object make_bit_vector_from_byte_vector (unsigned char *, size_t);
 Lisp_Object noseeum_make_marker (void);
 void garbage_collect_1 (void);
 Lisp_Object acons (Lisp_Object, Lisp_Object, Lisp_Object);
--- a/src/md5.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/md5.c	Mon Aug 13 11:07:39 2007 +0200
@@ -563,7 +563,7 @@
       CHECK_STRING (object);
       get_string_range_byte (object, start, end, &bstart, &bend,
 			     GB_HISTORICAL_STRING_BEHAVIOR);
-      instream = make_lisp_string_input_stream (object, bstart, bend);
+      instream = make_lisp_string_input_stream (object, bstart, bend - bstart);
     }
   GCPRO1 (instream);
--- a/src/menubar-msw.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/menubar-msw.c	Mon Aug 13 11:07:39 2007 +0200
@@ -623,7 +623,11 @@
   Lisp_Object data, fn, arg, frame;
   struct gcpro gcpro1;

+  if (NILP (current_hash_table))
+    return Qnil;
+
   data = Fgethash (make_int (id), current_hash_table, Qunbound);
+
   if (UNBOUNDP (data))
     {
       menu_cleanup (f);
--- a/src/opaque.h	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/opaque.h	Mon Aug 13 11:07:39 2007 +0200
@@ -80,7 +80,7 @@
 void free_opaque_ptr (Lisp_Object ptr);

 #define OPAQUE_SIZE(op) XINT ((op)->size_or_chain)
-#define OPAQUE_DATA(op) ((op)->data)
+#define OPAQUE_DATA(op) ((void *) ((op)->data))
 #define OPAQUE_MARKFUN(op) ((op)->markfun)
 #define XOPAQUE_SIZE(op) OPAQUE_SIZE (XOPAQUE (op))
 #define XOPAQUE_DATA(op) OPAQUE_DATA (XOPAQUE (op))
--- a/src/s/windowsnt.h	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/s/windowsnt.h	Mon Aug 13 11:07:39 2007 +0200
@@ -269,8 +269,8 @@
 #define putw      _putw
 #define umask     _umask
 /* #define utime     _utime */
-#define index     strchr
-#define rindex    strrchr
+/* #define index     strchr */
+/* #define rindex    strrchr */
 #define read	  _read
 #define write	  _write
 #define getcwd    _getcwd
--- a/src/sysdep.c	Mon Aug 13 11:07:11 2007 +0200
+++ b/src/sysdep.c	Mon Aug 13 11:07:39 2007 +0200
@@ -212,7 +212,9 @@
   }
 #endif

+#ifdef F_SETFL
   fcntl (fd, F_SETFL, O_NONBLOCK);
+#endif
 }

 #if defined (NO_SUBPROCESSES)
--- a/tests/automated/byte-compiler-tests.el	Mon Aug 13 11:07:11 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,93 +0,0 @@
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Martin Buchholz <martin@xemacs.org>
-;; Maintainer: Martin Buchholz <martin@xemacs.org>
-;; Created: 1998
-;; Keywords: tests
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: not in FSF Emacs.
-
-;;; Commentary:
-
-;;; Test byte-compiler functionality
-;;; See test-harness.el
-
-(condition-case err
-    (require 'test-harness)
-  (file-error
-   (when (and (boundp 'load-file-name) (stringp load-file-name))
-     (push (file-name-directory load-file-name) load-path)
-     (require 'test-harness))))
-
-(require 'bytecomp)
-
-;; test constant symbol warnings
-(defmacro check-byte-compiler-message (message-regexp &rest body)
-  `(Check-Message ,message-regexp (byte-compile '(lambda () ,@body))))
-
-(check-byte-compiler-message "Attempt to set non-symbol" (setq 1 1))
-(check-byte-compiler-message "Attempt to set constant symbol" (setq t 1))
-(check-byte-compiler-message "Attempt to set constant symbol" (setq nil 1))
-(check-byte-compiler-message "^$" (defconst :foo 1))
-
-(check-byte-compiler-message "Attempt to let-bind non-symbol" (let ((1 'x)) 1))
-(check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((t 'x)) (foo)))
-(check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((nil 'x)) (foo)))
-(check-byte-compiler-message "Attempt to let-bind constant symbol" (let ((:foo 'x)) (foo)))
-
-
-(check-byte-compiler-message "bound but not referenced" (let ((foo 'x)) 1))
-(Assert (not (boundp 'free-variable)))
-(Assert (boundp 'byte-compile-warnings))
-(check-byte-compiler-message "assignment to free variable" (setq free-variable 1))
-(check-byte-compiler-message "reference to free variable" (car free-variable))
-(check-byte-compiler-message "called with 2 args, but requires 1" (car 'x 'y))
-
-(check-byte-compiler-message "^$" (setq :foo 1))
-(let ((fun '(lambda () (setq :foo 1))))
-  (fset 'test-byte-compiler-fun fun))
-(Check-Error setting-constant (test-byte-compiler-fun))
-(byte-compile 'test-byte-compiler-fun)
-(Check-Error setting-constant (test-byte-compiler-fun))
-
-(eval-when-compile (defvar setq-test-foo nil) (defvar setq-test-bar nil))
-(progn
-  (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo))
-  (check-byte-compiler-message "set called with 1 arg, but requires 2" (setq setq-test-foo 1 setq-test-bar))
-  (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo))
-  (check-byte-compiler-message "set-default called with 1 arg, but requires 2" (setq-default setq-test-foo 1 setq-test-bar))
-  )
-
-;;-----------------------------------------------------
-;; let, let*
-;;-----------------------------------------------------
-
-;; Test interpreted and compiled lisp separately here
-(check-byte-compiler-message "malformed let binding" (let  ((x 1 2)) 3))
-(check-byte-compiler-message "malformed let binding" (let* ((x 1 2)) 3))
-
-(Check-Error-Message
- error "`let' bindings can have only one value-form"
- (eval '(let ((x 1 2)) 3)))
-
-(Check-Error-Message
- error "`let' bindings can have only one value-form"
- (eval '(let* ((x 1 2)) 3)))
-
--- a/tests/automated/database-tests.el	Mon Aug 13 11:07:11 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,62 +0,0 @@
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Martin Buchholz <martin@xemacs.org>
-;; Maintainer: Martin Buchholz <martin@xemacs.org>
-;; Created: 1998
-;; Keywords: tests, database
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: not in FSF Emacs.
-
-;;; Commentary:
-
-;;; Test database functionality
-;;; See test-harness.el
-
-(condition-case err
-    (require 'test-harness)
-  (file-error
-   (when (and (boundp 'load-file-name) (stringp load-file-name))
-     (push (file-name-directory load-file-name) load-path)
-     (require 'test-harness))))
-
-(flet ((test-database
-	(db)
-	(Assert (databasep db))
-	(put-database "key1" "val1" db)
-	(Assert (equal "val1" (get-database "key1" db)))
-	(remove-database "key1" db)
-	(Assert (equal nil (get-database "key1" db)))
-	(close-database db)
-	(Assert (not (database-live-p db)))
-	(Assert (databasep db))
-	(let ((filename (database-file-name db)))
-	  (dolist (fn (list filename (concat filename ".db")))
-	    (condition-case nil (delete-file fn) (file-error nil))))))
-
-  (let ((filename (expand-file-name "test-harness" (temp-directory))))
-
-    (dolist (fn (list filename (concat filename ".db")))
-      (condition-case nil (delete-file fn) (file-error nil)))
-
-    (dolist (db-type `(dbm berkeley-db))
-      (when (featurep db-type)
-	(princ "\n")
-	(test-database (open-database filename db-type))))
-    ))
--- a/tests/automated/hash-table-tests.el	Mon Aug 13 11:07:11 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,269 +0,0 @@
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Martin Buchholz <martin@xemacs.org>
-;; Maintainer: Martin Buchholz <martin@xemacs.org>
-;; Created: 1998
-;; Keywords: tests, database
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: not in FSF Emacs.
-
-;;; Commentary:
-
-;;; Test database functionality
-;;; See test-harness.el
-
-(condition-case err
-    (require 'test-harness)
-  (file-error
-   (when (and (boundp 'load-file-name) (stringp load-file-name))
-     (push (file-name-directory load-file-name) load-path)
-     (require 'test-harness))))
-
-;; Test all combinations of make-hash-table keywords
-(dolist (type `(non-weak weak key-weak value-weak))
-  (dolist (test `(eq eql equal))
-    (dolist (size `(0 1 100))
-      (dolist (rehash-size `(1.1 9.9))
-	(dolist (rehash-threshold `(0.2 .9))
-	  (dolist (data `(() (1 2) (1 2 3 4)))
-	    (let ((ht (make-hash-table :test test
-				       :type type
-				       :size size
-				       :rehash-size rehash-size
-				       :rehash-threshold rehash-threshold)))
-	      (Assert (equal ht (car (let ((print-readably t))
-				       (read-from-string (prin1-to-string ht))))))
-	      (Assert (eq test (hash-table-test ht)))
-	      (Assert (eq type (hash-table-type ht)))
-	      (Assert (<= size (hash-table-size ht)))
-	      (Assert (eql rehash-size (hash-table-rehash-size ht)))
-	      (Assert (eql rehash-threshold (hash-table-rehash-threshold ht))))))))))
-
-(loop for (fun type) in `((make-hashtable non-weak)
-			  (make-weak-hashtable weak)
-			  (make-key-weak-hashtable key-weak)
-			  (make-value-weak-hashtable value-weak))
-  do (Assert (eq type (hash-table-type (funcall fun 10)))))
-
-(let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq))
-      (size 80))
-  (Assert (hashtablep ht))
-  (Assert (hash-table-p ht))
-  (Assert (eq 'eq (hash-table-test ht)))
-  (Assert (eq 'non-weak (hash-table-type ht)))
-  (Assert (eq 'non-weak (hashtable-type ht)))
-  (dotimes (j size)
-    (puthash j (- j) ht)
-    (Assert (eq (gethash j ht) (- j)))
-    (Assert (= (hash-table-count ht) (1+ j)))
-    (Assert (= (hashtable-fullness ht) (hash-table-count ht)))
-    (puthash j j ht)
-    (Assert (eq (gethash j ht 'foo) j))
-    (Assert (= (hash-table-count ht) (1+ j)))
-    (setf (gethash j ht) (- j))
-    (Assert (eq (gethash j ht) (- j)))
-    (Assert (= (hash-table-count ht) (1+ j))))
-
-  (clrhash ht)
-  (Assert (= 0 (hash-table-count ht)))
-
-  (dotimes (j size)
-    (puthash j (- j) ht)
-    (Assert (eq (gethash j ht) (- j)))
-    (Assert (= (hash-table-count ht) (1+ j))))
-
-  (let ((k-sum 0) (v-sum 0))
-    (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
-    (print k-sum)
-    (print v-sum)
-    (Assert (= k-sum (/ (* size (- size 1)) 2)))
-    (Assert (= v-sum (- k-sum))))
-
-  (let ((count size))
-    (dotimes (j size)
-      (remhash j ht)
-      (Assert (eq (gethash j ht) nil))
-      (Assert (eq (gethash j ht 'foo) 'foo))
-      (Assert (= (hash-table-count ht) (decf count))))))
-
-(let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal))
-      (size 70))
-  (Assert (hashtablep ht))
-  (Assert (hash-table-p ht))
-  (Assert (>= (hash-table-size ht) (/ 30 .25)))
-  (Assert (eql .25 (hash-table-rehash-threshold ht)))
-  (Assert (eq 'equal (hash-table-test ht)))
-  (Assert (eq (hash-table-test ht) (hashtable-test-function ht)))
-  (Assert (eq 'non-weak (hash-table-type ht)))
-  (dotimes (j size)
-    (puthash (int-to-string j) (- j) ht)
-    (Assert (eq (gethash (int-to-string j) ht) (- j)))
-    (Assert (= (hash-table-count ht) (1+ j)))
-    (puthash (int-to-string j) j ht)
-    (Assert (eq (gethash (int-to-string j) ht 'foo) j))
-    (Assert (= (hash-table-count ht) (1+ j))))
-
-  (clrhash ht)
-  (Assert (= 0 (hash-table-count ht)))
-  (Assert (equal ht (copy-hash-table ht)))
-
-  (dotimes (j size)
-    (setf (gethash (int-to-string j) ht) (- j))
-    (Assert (eq (gethash (int-to-string j) ht) (- j)))
-    (Assert (= (hash-table-count ht) (1+ j))))
-
-  (let ((count size))
-    (dotimes (j size)
-      (remhash (int-to-string j) ht)
-      (Assert (eq (gethash (int-to-string j) ht) nil))
-      (Assert (eq (gethash (int-to-string j) ht 'foo) 'foo))
-      (Assert (= (hash-table-count ht) (decf count))))))
-
-(let ((iterations 5) (one 1.0) (two 2.0))
-  (flet ((check-copy
-	  (ht)
-	  (let ((copy-of-ht (copy-hash-table ht)))
-	    (Assert (equal ht copy-of-ht))
-	    (Assert (not (eq ht copy-of-ht)))
-	    (Assert (eq  (hash-table-count ht) (hash-table-count copy-of-ht)))
-	    (Assert (eq  (hash-table-type  ht) (hash-table-type  copy-of-ht)))
-	    (Assert (eq  (hash-table-size  ht) (hash-table-size  copy-of-ht)))
-	    (Assert (eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht)))
-	    (Assert (eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht))))))
-
-  (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq)))
-    (dotimes (j iterations)
-      (puthash (+ one 0.0) t ht)
-      (puthash (+ two 0.0) t ht)
-      (puthash (concat "1" "2") t ht)
-      (puthash (concat "3" "4") t ht))
-    (Assert (eq (hashtable-test-function ht) 'eq))
-    (Assert (eq (hash-table-test ht) 'eq))
-    (Assert (= (* iterations 4) (hash-table-count ht)))
-    (Assert (eq nil (gethash 1.0 ht)))
-    (Assert (eq nil (gethash "12" ht)))
-    (check-copy ht)
-    )
-
-  (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eql)))
-    (dotimes (j iterations)
-      (puthash (+ one 0.0) t ht)
-      (puthash (+ two 0.0) t ht)
-      (puthash (concat "1" "2") t ht)
-      (puthash (concat "3" "4") t ht))
-    (Assert (eq (hashtable-test-function ht) 'eql))
-    (Assert (eq (hash-table-test ht) 'eql))
-    (Assert (= (+ 2 (* 2 iterations)) (hash-table-count ht)))
-    (Assert (eq t (gethash 1.0 ht)))
-    (Assert (eq nil (gethash "12" ht)))
-    (check-copy ht)
-    )
-
-  (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equal)))
-    (dotimes (j iterations)
-      (puthash (+ one 0.0) t ht)
-      (puthash (+ two 0.0) t ht)
-      (puthash (concat "1" "2") t ht)
-      (puthash (concat "3" "4") t ht))
-    (Assert (eq (hashtable-test-function ht) 'equal))
-    (Assert (eq (hash-table-test ht) 'equal))
-    (Assert (= 4 (hash-table-count ht)))
-    (Assert (eq t (gethash 1.0 ht)))
-    (Assert (eq t (gethash "12" ht)))
-    (check-copy ht)
-    )
-
-  ))
-
-;; Test that weak hash-tables are properly handled
-(loop for (type expected-count expected-k-sum expected-v-sum) in
-  `((non-weak 6 38 25)
-    (weak 3 6 9)
-    (key-weak 4 38 9)
-    (value-weak 4 6 25))
-  do
-  (let* ((ht (make-hash-table :type type))
-       (my-obj (cons ht ht)))
-  (garbage-collect)
-  (puthash my-obj 1 ht)
-  (puthash 2 my-obj ht)
-  (puthash 4 8 ht)
-  (puthash (cons ht ht) 16 ht)
-  (puthash 32 (cons ht ht) ht)
-  (puthash (cons ht ht) (cons ht ht) ht)
-  (let ((k-sum 0) (v-sum 0))
-    (maphash #'(lambda (k v)
-		 (when (integerp k) (incf k-sum k))
-		 (when (integerp v) (incf v-sum v)))
-	     ht)
-    (Assert (eq 38 k-sum))
-    (Assert (eq 25 v-sum)))
-  (Assert (eq 6 (hash-table-count ht)))
-  (garbage-collect)
-  (Assert (eq expected-count (hash-table-count ht)))
-  (let ((k-sum 0) (v-sum 0))
-    (maphash #'(lambda (k v)
-		 (when (integerp k) (incf k-sum k))
-		 (when (integerp v) (incf v-sum v)))
-	     ht)
-    (Assert (eq expected-k-sum k-sum))
-    (Assert (eq expected-v-sum v-sum)))))
-
-;;; Test the ability to puthash and remhash the current elt of a maphash
-(let ((ht (make-hash-table :test 'eql)))
-  (dotimes (j 100) (setf (gethash j ht) (- j)))
-  (maphash #'(lambda (k v)
-	       (if (oddp k) (remhash k ht) (puthash k (- v) ht)))
-	   ht)
-  (let ((k-sum 0) (v-sum 0))
-    (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
-    (Assert (= (* 50 49) k-sum))
-    (Assert (= v-sum k-sum))))
-
-;;; Test reading and printing of hash-table objects
-(let ((h1 #s(hashtable  type weak rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
-      (h2 #s(hash-table type weak rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
-      (h3 (make-hash-table :type 'weak :rehash-size 3.0 :rehash-threshold .2 :test 'eq)))
-  (Assert (equal h1 h2))
-  (Assert (not (equal h1 h3)))
-  (puthash 1 2 h3)
-  (puthash 3 4 h3)
-  (Assert (equal h1 h3)))
-
-;;; Testing equality of hash tables
-(Assert (equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0)
-	       (make-hash-table :test 'eql)))
-(Assert (not (equal (make-hash-table :test 'eq)
-		    (make-hash-table :test 'equal))))
-(let ((h1 (make-hash-table))
-      (h2 (make-hash-table)))
-  (Assert (equal h1 h2))
-  (Assert (not (eq h1 h2)))
-  (puthash 1 2 h1)
-  (Assert (not (equal h1 h2)))
-  (puthash 1 2 h2)
-  (Assert (equal h1 h2))
-  (puthash 1 3 h2)
-  (Assert (not (equal h1 h2)))
-  (clrhash h1)
-  (Assert (not (equal h1 h2)))
-  (clrhash h2)
-  (Assert (equal h1 h2))
-  )
--- a/tests/automated/lisp-tests.el	Mon Aug 13 11:07:11 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,727 +0,0 @@
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Martin Buchholz <martin@xemacs.org>
-;; Maintainer: Martin Buchholz <martin@xemacs.org>
-;; Created: 1998
-;; Keywords: tests
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: not in FSF Emacs.
-
-;;; Commentary:
-
-;;; Test basic Lisp engine functionality
-;;; See test-harness.el for instructions on how to run these tests.
-
-(eval-when-compile
-  (condition-case nil
-      (require 'test-harness)
-    (file-error
-     (push "." load-path)
-     (when (and (boundp 'load-file-name) (stringp load-file-name))
-       (push (file-name-directory load-file-name) load-path))
-     (require 'test-harness))))
-
-(Check-Error wrong-number-of-arguments (setq setq-test-foo))
-(Check-Error wrong-number-of-arguments (setq setq-test-foo 1 setq-test-bar))
-(Check-Error wrong-number-of-arguments (setq-default setq-test-foo))
-(Check-Error wrong-number-of-arguments (setq-default setq-test-foo 1 setq-test-bar))
-(Assert (eq (setq)         nil))
-(Assert (eq (setq-default) nil))
-(Assert (eq (setq         setq-test-foo 42) 42))
-(Assert (eq (setq-default setq-test-foo 42) 42))
-(Assert (eq (setq         setq-test-foo 42 setq-test-bar 99) 99))
-(Assert (eq (setq-default setq-test-foo 42 setq-test-bar 99) 99))
-
-(macrolet ((test-setq (expected-result &rest body)
-		      `(progn
-			 (defun test-setq-fun () ,@body)
-			 (Assert (eq ,expected-result (test-setq-fun)))
-			 (byte-compile 'test-setq-fun)
-			 (Assert (eq ,expected-result (test-setq-fun))))))
-  (test-setq nil (setq))
-  (test-setq nil (setq-default))
-  (test-setq 42  (setq         test-setq-var 42))
-  (test-setq 42  (setq-default test-setq-var 42))
-  (test-setq 42  (setq         test-setq-bar 99 test-setq-var 42))
-  (test-setq 42  (setq-default test-setq-bar 99 test-setq-var 42))
-  )
-
-(let ((my-vector [1 2 3 4])
-      (my-bit-vector (bit-vector 1 0 1 0))
-      (my-string "1234")
-      (my-list '(1 2 3 4)))
-
-  ;;(Assert (fooooo)) ;; Generate Other failure
-  ;;(Assert (eq 1 2)) ;; Generate Assertion failure
-
-  (dolist (sequence (list my-vector my-bit-vector my-string my-list))
-    (Assert (sequencep sequence))
-    (Assert (eq 4 (length sequence))))
-
-  (dolist (array (list my-vector my-bit-vector my-string))
-    (Assert (arrayp array)))
-
-  (Assert (eq (elt my-vector 0) 1))
-  (Assert (eq (elt my-bit-vector 0) 1))
-  (Assert (eq (elt my-string 0) ?1))
-  (Assert (eq (elt my-list 0) 1))
-
-  (fillarray my-vector 5)
-  (fillarray my-bit-vector 1)
-  (fillarray my-string ?5)
-
-  (dolist (array (list my-vector my-bit-vector))
-    (Assert (eq 4 (length array))))
-
-  (Assert (eq (elt my-vector 0) 5))
-  (Assert (eq (elt my-bit-vector 0) 1))
-  (Assert (eq (elt my-string 0) ?5))
-
-  (Assert (eq (elt my-vector 3) 5))
-  (Assert (eq (elt my-bit-vector 3) 1))
-  (Assert (eq (elt my-string 3) ?5))
-
-  (fillarray my-bit-vector 0)
-  (Assert (eq 4 (length my-bit-vector)))
-  (Assert (eq (elt my-bit-vector 2) 0))
-  )
-
-(defun make-circular-list (length)
-  "Create evil emacs-crashing circular list of length LENGTH"
-  (let ((circular-list
-	 (make-list
-	  length
-	  'you-are-trapped-in-a-twisty-maze-of-cons-cells-all-alike)))
-    (setcdr (last circular-list) circular-list)
-    circular-list))
-
-;;-----------------------------------------------------
-;; Test `nconc'
-;;-----------------------------------------------------
-(defun make-list-012 () (list 0 1 2))
-
-(Check-Error wrong-type-argument (nconc 'foo nil))
-
-(dolist (length `(1 2 3 4 1000 2000))
-  (Check-Error circular-list (nconc (make-circular-list length) 'foo))
-  (Check-Error circular-list (nconc '(1 . 2) (make-circular-list length) 'foo))
-  (Check-Error circular-list (nconc '(1 . 2) '(3 . 4) (make-circular-list length) 'foo)))
-
-(Assert (eq (nconc) nil))
-(Assert (eq (nconc nil) nil))
-(Assert (eq (nconc nil nil) nil))
-(Assert (eq (nconc nil nil nil) nil))
-
-(let ((x (make-list-012))) (Assert (eq (nconc nil x) x)))
-(let ((x (make-list-012))) (Assert (eq (nconc x nil) x)))
-(let ((x (make-list-012))) (Assert (eq (nconc nil x nil) x)))
-(let ((x (make-list-012))) (Assert (eq (nconc x) x)))
-(let ((x (make-list-012))) (Assert (eq (nconc x (make-circular-list 3)) x)))
-
-(Assert (equal (nconc '(1 . 2) '(3 . 4) '(5 . 6)) '(1 3 5 . 6)))
-
-(let ((y (nconc (make-list-012) nil (list 3 4 5) nil)))
-  (Assert (eq (length y) 6))
-  (Assert (eq (nth 3 y) 3)))
-
-;;-----------------------------------------------------
-;; Test `last'
-;;-----------------------------------------------------
-(Check-Error wrong-type-argument (last 'foo))
-(Check-Error wrong-number-of-arguments (last))
-(Check-Error wrong-number-of-arguments (last '(1 2) 1 1))
-(Check-Error circular-list (last (make-circular-list 1)))
-(Check-Error circular-list (last (make-circular-list 2000)))
-(let ((x (list 0 1 2 3)))
-  (Assert (eq (last nil) nil))
-  (Assert (eq (last x 0) nil))
-  (Assert (eq (last x  ) (cdddr x)))
-  (Assert (eq (last x 1) (cdddr x)))
-  (Assert (eq (last x 2) (cddr x)))
-  (Assert (eq (last x 3) (cdr x)))
-  (Assert (eq (last x 4) x))
-  (Assert (eq (last x 9) x))
-  (Assert (eq (last `(1 . 2) 0) 2))
-  )
-
-;;-----------------------------------------------------
-;; Test `butlast' and `nbutlast'
-;;-----------------------------------------------------
-(Check-Error wrong-type-argument (butlast  'foo))
-(Check-Error wrong-type-argument (nbutlast 'foo))
-(Check-Error wrong-number-of-arguments (butlast))
-(Check-Error wrong-number-of-arguments (nbutlast))
-(Check-Error wrong-number-of-arguments (butlast  '(1 2) 1 1))
-(Check-Error wrong-number-of-arguments (nbutlast '(1 2) 1 1))
-(Check-Error circular-list (butlast  (make-circular-list 1)))
-(Check-Error circular-list (nbutlast (make-circular-list 1)))
-(Check-Error circular-list (butlast  (make-circular-list 2000)))
-(Check-Error circular-list (nbutlast (make-circular-list 2000)))
-
-(let* ((x (list 0 1 2 3))
-       (y (butlast x))
-       (z (nbutlast x)))
-  (Assert (eq z x))
-  (Assert (not (eq y x)))
-  (Assert (equal y '(0 1 2)))
-  (Assert (equal z y)))
-
-(let* ((x (list 0 1 2 3 4))
-       (y (butlast x 2))
-       (z (nbutlast x 2)))
-  (Assert (eq z x))
-  (Assert (not (eq y x)))
-  (Assert (equal y '(0 1 2)))
-  (Assert (equal z y)))
-
-(let* ((x (list 0 1 2 3))
-       (y (butlast x 0))
-       (z (nbutlast x 0)))
-  (Assert (eq z x))
-  (Assert (not (eq y x)))
-  (Assert (equal y '(0 1 2 3)))
-  (Assert (equal z y)))
-
-(Assert (eq (butlast  '(x)) nil))
-(Assert (eq (nbutlast '(x)) nil))
-(Assert (eq (butlast  '()) nil))
-(Assert (eq (nbutlast '()) nil))
-
-;;-----------------------------------------------------
-;; Test `copy-list'
-;;-----------------------------------------------------
-(Check-Error wrong-type-argument (copy-list 'foo))
-(Check-Error wrong-number-of-arguments (copy-list))
-(Check-Error wrong-number-of-arguments (copy-list '(1 2) 1))
-(Check-Error circular-list (copy-list (make-circular-list 1)))
-(Check-Error circular-list (copy-list (make-circular-list 2000)))
-(Assert (eq '() (copy-list '())))
-(dolist (x `((1) (1 2) (1 2 3) (1 2 . 3)))
-  (let ((y (copy-list x)))
-    (Assert (and (equal x y) (not (eq x y))))))
-
-;;-----------------------------------------------------
-;; Arithmetic operations
-;;-----------------------------------------------------
-
-;; Test `+'
-(Assert (eq (+ 1 1) 2))
-(Assert (= (+ 1.0 1.0) 2.0))
-(Assert (= (+ 1.0 3.0 0.0) 4.0))
-(Assert (= (+ 1 1.0) 2.0))
-(Assert (= (+ 1.0 1) 2.0))
-(Assert (= (+ 1.0 1 1) 3.0))
-(Assert (= (+ 1 1 1.0) 3.0))
-
-;; Test `-'
-(Check-Error wrong-number-of-arguments (-))
-(Assert (eq (- 0) 0))
-(Assert (eq (- 1) -1))
-(dolist (one `(1 1.0 ?\1 ,(Int-to-Marker 1)))
-  (Assert (= (+ 1 one) 2))
-  (Assert (= (+ one) 1))
-  (Assert (= (+ one) one))
-  (Assert (= (- one) -1))
-  (Assert (= (- one one) 0))
-  (Assert (= (- one one one) -1))
-  (Assert (= (+ one 1) 2))
-  (dolist (zero `(0 0.0 ?\0))
-    (Assert (= (+ 1 zero) 1))
-    (Assert (= (+ zero 1) 1))
-    (Assert (= (- zero) zero))
-    (Assert (= (- zero) 0))
-    (Assert (= (- zero zero) 0))
-    (Assert (= (- zero one one) -2))))
-
-(Assert (= (- 1.5 1) .5))
-(Assert (= (- 1 1.5) (- .5)))
-
-;; Test `/'
-
-;; Test division by zero errors
-(dolist (zero `(0 0.0 ?\0))
-  (Check-Error arith-error (/ zero))
-  (dolist (n1 `(42 42.0 ?\042 ,(Int-to-Marker 42)))
-    (Check-Error arith-error (/ n1 zero))
-    (dolist (n2 `(3 3.0 ?\03 ,(Int-to-Marker 3)))
-      (Check-Error arith-error (/ n1 n2 zero)))))
-
-;; Other tests for `/'
-(Check-Error wrong-number-of-arguments (/))
-(let (x)
-  (Assert (= (/ (setq x 2))   0))
-  (Assert (= (/ (setq x 2.0)) 0.5)))
-
-(dolist (six `(6 6.0 ?\06))
-  (dolist (two `(2 2.0 ?\02))
-    (dolist (three `(3 3.0 ?\03))
-      (Assert (= (/ six two) three)))))
-
-(dolist (three `(3 3.0 ?\03))
-  (Assert (= (/ three 2.0) 1.5)))
-(dolist (two `(2 2.0 ?\02))
-  (Assert (= (/ 3.0 two) 1.5)))
-
-;; Test `*'
-(Assert (= 1 (*)))
-
-(dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
-  (Assert (= 1 (* one))))
-
-(dolist (two `(2 2.0 ?\02))
-  (Assert (= 2 (* two))))
-
-(dolist (six `(6 6.0 ?\06))
-  (dolist (two `(2 2.0 ?\02))
-    (dolist (three `(3 3.0 ?\03))
-      (Assert (= (* three two) six)))))
-
-(dolist (three `(3 3.0 ?\03))
-  (dolist (two `(2 2.0 ?\02))
-    (Assert (= (* 1.5 two) three))
-    (dolist (five `(5 5.0 ?\05))
-      (Assert (= 30 (* five two three))))))
-
-;; Test `+'
-(Assert (= 0 (+)))
-
-(dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
-  (Assert (= 1 (+ one))))
-
-(dolist (two `(2 2.0 ?\02))
-  (Assert (= 2 (+ two))))
-
-(dolist (five `(5 5.0 ?\05))
-  (dolist (two `(2 2.0 ?\02))
-    (dolist (three `(3 3.0 ?\03))
-      (Assert (= (+ three two) five))
-      (Assert (= 10 (+ five two three))))))
-
-;; Test `max', `min'
-(dolist (one `(1 1.0 ?\01 ,(Int-to-Marker 1)))
-  (Assert (= one (max one)))
-  (Assert (= one (max one one)))
-  (Assert (= one (max one one one)))
-  (Assert (= one (min one)))
-  (Assert (= one (min one one)))
-  (Assert (= one (min one one one)))
-  (dolist (two `(2 2.0 ?\02 ,(Int-to-Marker 2)))
-    (Assert (= one (min one two)))
-    (Assert (= one (min one two two)))
-    (Assert (= one (min two two one)))
-    (Assert (= two (max one two)))
-    (Assert (= two (max one two two)))
-    (Assert (= two (max two two one)))))
-
-;;-----------------------------------------------------
-;; Logical bit-twiddling operations
-;;-----------------------------------------------------
-(Assert (= (logxor)  0))
-(Assert (= (logior)  0))
-(Assert (= (logand) -1))
-
-(Check-Error wrong-type-argument (logxor 3.0))
-(Check-Error wrong-type-argument (logior 3.0))
-(Check-Error wrong-type-argument (logand 3.0))
-
-(dolist (three `(3 ?\03))
-  (Assert (eq 3 (logand three)))
-  (Assert (eq 3 (logxor three)))
-  (Assert (eq 3 (logior three)))
-  (Assert (eq 3 (logand three three)))
-  (Assert (eq 0 (logxor three three)))
-  (Assert (eq 3 (logior three three))))
-
-(dolist (one `(1 ?\01 ,(Int-to-Marker 1)))
-  (dolist (two `(2 ?\02))
-    (Assert (eq 0 (logand one two)))
-    (Assert (eq 3 (logior one two)))
-    (Assert (eq 3 (logxor one two))))
-  (dolist (three `(3 ?\03))
-    (Assert (eq 1 (logand one three)))
-    (Assert (eq 3 (logior one three)))
-    (Assert (eq 2 (logxor one three)))))
-
-;;-----------------------------------------------------
-;; Test `%', mod
-;;-----------------------------------------------------
-(Check-Error wrong-number-of-arguments (%))
-(Check-Error wrong-number-of-arguments (% 1))
-(Check-Error wrong-number-of-arguments (% 1 2 3))
-
-(Check-Error wrong-number-of-arguments (mod))
-(Check-Error wrong-number-of-arguments (mod 1))
-(Check-Error wrong-number-of-arguments (mod 1 2 3))
-
-(Check-Error wrong-type-argument (% 10.0 2))
-(Check-Error wrong-type-argument (% 10 2.0))
-
-(dotimes (j 30)
-  (let ((x (- (random) (random))))
-    (Assert (eq x (+ (% x 17) (* (/ x 17) 17))))
-    (Assert (eq (- x) (+ (% (- x) 17) (* (/ (- x) 17) 17))))
-    (Assert (eq (% x -17) (- (% (- x) 17))))
-    ))
-
-(macrolet
-    ((division-test (seven)
-    `(progn
-       (Assert (eq (% ,seven      2)  1))
-       (Assert (eq (% ,seven     -2)  1))
-       (Assert (eq (% (- ,seven)  2) -1))
-       (Assert (eq (% (- ,seven) -2) -1))
-
-       (Assert (eq (% ,seven      4)  3))
-       (Assert (eq (% ,seven     -4)  3))
-       (Assert (eq (% (- ,seven)  4) -3))
-       (Assert (eq (% (- ,seven) -4) -3))
-
-       (Assert (eq (%  35 ,seven)     0))
-       (Assert (eq (% -35 ,seven)     0))
-       (Assert (eq (%  35 (- ,seven)) 0))
-       (Assert (eq (% -35 (- ,seven)) 0))
-
-       (Assert (eq (mod ,seven      2)  1))
-       (Assert (eq (mod ,seven     -2) -1))
-       (Assert (eq (mod (- ,seven)  2)  1))
-       (Assert (eq (mod (- ,seven) -2) -1))
-
-       (Assert (eq (mod ,seven      4)  3))
-       (Assert (eq (mod ,seven     -4) -1))
-       (Assert (eq (mod (- ,seven)  4)  1))
-       (Assert (eq (mod (- ,seven) -4) -3))
-
-       (Assert (eq (mod  35 ,seven)     0))
-       (Assert (eq (mod -35 ,seven)     0))
-       (Assert (eq (mod  35 (- ,seven)) 0))
-       (Assert (eq (mod -35 (- ,seven)) 0))
-
-       (Assert (= (mod ,seven      2.0)  1.0))
-       (Assert (= (mod ,seven     -2.0) -1.0))
-       (Assert (= (mod (- ,seven)  2.0)  1.0))
-       (Assert (= (mod (- ,seven) -2.0) -1.0))
-
-       (Assert (= (mod ,seven      4.0)  3.0))
-       (Assert (= (mod ,seven     -4.0) -1.0))
-       (Assert (= (mod (- ,seven)  4.0)  1.0))
-       (Assert (= (mod (- ,seven) -4.0) -3.0))
-
-       (Assert (eq (% 0 ,seven) 0))
-       (Assert (eq (% 0 (- ,seven)) 0))
-
-       (Assert (eq (mod 0 ,seven) 0))
-       (Assert (eq (mod 0 (- ,seven)) 0))
-
-       (Assert (= (mod 0.0 ,seven) 0.0))
-       (Assert (= (mod 0.0 (- ,seven)) 0.0)))))
-
-  (division-test 7)
-  (division-test ?\07)
-  (division-test (Int-to-Marker 7)))
-
-
-
-;;-----------------------------------------------------
-;; Arithmetic comparison operations
-;;-----------------------------------------------------
-(Check-Error wrong-number-of-arguments (=))
-(Check-Error wrong-number-of-arguments (<))
-(Check-Error wrong-number-of-arguments (>))
-(Check-Error wrong-number-of-arguments (<=))
-(Check-Error wrong-number-of-arguments (>=))
-(Check-Error wrong-number-of-arguments (/=))
-
-;; One argument always yields t
-(loop for x in `(1 1.0 ,(Int-to-Marker 1) ?z) do
-  (Assert (eq t (=  x)))
-  (Assert (eq t (<  x)))
-  (Assert (eq t (>  x)))
-  (Assert (eq t (>= x)))
-  (Assert (eq t (<= x)))
-  (Assert (eq t (/= x)))
-  )
-
-;; Type checking
-(Check-Error wrong-type-argument (=  'foo 1))
-(Check-Error wrong-type-argument (<= 'foo 1))
-(Check-Error wrong-type-argument (>= 'foo 1))
-(Check-Error wrong-type-argument (<  'foo 1))
-(Check-Error wrong-type-argument (>  'foo 1))
-(Check-Error wrong-type-argument (/= 'foo 1))
-
-;; Meat
-(dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
-  (dolist (two `(2 2.0 ?\02))
-    (Assert (<  one two))
-    (Assert (<= one two))
-    (Assert (<= two two))
-    (Assert (>  two one))
-    (Assert (>= two one))
-    (Assert (>= two two))
-    (Assert (/= one two))
-    (Assert (not (/= two two)))
-    (Assert (not (< one one)))
-    (Assert (not (> one one)))
-    (Assert (<= one one two two))
-    (Assert (not (< one one two two)))
-    (Assert (>= two two one one))
-    (Assert (not (> two two one one)))
-    (Assert (= one one one))
-    (Assert (not (= one one one two)))
-    (Assert (not (/= one two one)))
-    ))
-
-(dolist (one `(1 1.0 ,(Int-to-Marker 1) ?\01))
-  (dolist (two `(2 2.0 ?\02))
-    (Assert (<  one two))
-    (Assert (<= one two))
-    (Assert (<= two two))
-    (Assert (>  two one))
-    (Assert (>= two one))
-    (Assert (>= two two))
-    (Assert (/= one two))
-    (Assert (not (/= two two)))
-    (Assert (not (< one one)))
-    (Assert (not (> one one)))
-    (Assert (<= one one two two))
-    (Assert (not (< one one two two)))
-    (Assert (>= two two one one))
-    (Assert (not (> two two one one)))
-    (Assert (= one one one))
-    (Assert (not (= one one one two)))
-    (Assert (not (/= one two one)))
-    ))
-
-;; ad-hoc
-(Assert (< 1 2))
-(Assert (< 1 2 3 4 5 6))
-(Assert (not (< 1 1)))
-(Assert (not (< 2 1)))
-
-
-(Assert (not (< 1 1)))
-(Assert (< 1 2 3 4 5 6))
-(Assert (<= 1 2 3 4 5 6))
-(Assert (<= 1 2 3 4 5 6 6))
-(Assert (not (< 1 2 3 4 5 6 6)))
-(Assert (<= 1 1))
-
-(Assert (not (eq (point) (point-marker))))
-(Assert (= 1 (Int-to-Marker 1)))
-(Assert (= (point) (point-marker)))
-
-;;-----------------------------------------------------
-;; testing list-walker functions
-;;-----------------------------------------------------
-(macrolet
-    ((test-fun
-      (fun)
-      `(progn
-	 (Check-Error wrong-number-of-arguments (,fun))
-	 (Check-Error wrong-number-of-arguments (,fun nil))
-	 (Check-Error malformed-list (,fun nil 1))
-	 ,@(loop for n in `(1 2 2000)
-	     collect `(Check-Error circular-list (,fun 1 (make-circular-list ,n))))))
-     (test-funs (&rest funs) `(progn ,@(loop for fun in funs collect `(test-fun ,fun)))))
-
-  (test-funs member old-member
-	     memq   old-memq
-	     assoc  old-assoc
-	     rassoc old-rassoc
-	     rassq  old-rassq
-	     delete old-delete
-	     delq   old-delq
-	     remassoc remassq remrassoc remrassq))
-
-(let ((x '((1 . 2) 3 (4 . 5))))
-  (Assert (eq (assoc  1 x) (car x)))
-  (Assert (eq (assq   1 x) (car x)))
-  (Assert (eq (rassoc 1 x) nil))
-  (Assert (eq (rassq  1 x) nil))
-  (Assert (eq (assoc  2 x) nil))
-  (Assert (eq (assq   2 x) nil))
-  (Assert (eq (rassoc 2 x) (car x)))
-  (Assert (eq (rassq  2 x) (car x)))
-  (Assert (eq (assoc  3 x) nil))
-  (Assert (eq (assq   3 x) nil))
-  (Assert (eq (rassoc 3 x) nil))
-  (Assert (eq (rassq  3 x) nil))
-  (Assert (eq (assoc  4 x) (caddr x)))
-  (Assert (eq (assq   4 x) (caddr x)))
-  (Assert (eq (rassoc 4 x) nil))
-  (Assert (eq (rassq  4 x) nil))
-  (Assert (eq (assoc  5 x) nil))
-  (Assert (eq (assq   5 x) nil))
-  (Assert (eq (rassoc 5 x) (caddr x)))
-  (Assert (eq (rassq  5 x) (caddr x)))
-  (Assert (eq (assoc  6 x) nil))
-  (Assert (eq (assq   6 x) nil))
-  (Assert (eq (rassoc 6 x) nil))
-  (Assert (eq (rassq  6 x) nil)))
-
-(let ((x '(("1" . "2") "3" ("4" . "5"))))
-  (Assert (eq (assoc  "1" x) (car x)))
-  (Assert (eq (assq   "1" x) nil))
-  (Assert (eq (rassoc "1" x) nil))
-  (Assert (eq (rassq  "1" x) nil))
-  (Assert (eq (assoc  "2" x) nil))
-  (Assert (eq (assq   "2" x) nil))
-  (Assert (eq (rassoc "2" x) (car x)))
-  (Assert (eq (rassq  "2" x) nil))
-  (Assert (eq (assoc  "3" x) nil))
-  (Assert (eq (assq   "3" x) nil))
-  (Assert (eq (rassoc "3" x) nil))
-  (Assert (eq (rassq  "3" x) nil))
-  (Assert (eq (assoc  "4" x) (caddr x)))
-  (Assert (eq (assq   "4" x) nil))
-  (Assert (eq (rassoc "4" x) nil))
-  (Assert (eq (rassq  "4" x) nil))
-  (Assert (eq (assoc  "5" x) nil))
-  (Assert (eq (assq   "5" x) nil))
-  (Assert (eq (rassoc "5" x) (caddr x)))
-  (Assert (eq (rassq  "5" x) nil))
-  (Assert (eq (assoc  "6" x) nil))
-  (Assert (eq (assq   "6" x) nil))
-  (Assert (eq (rassoc "6" x) nil))
-  (Assert (eq (rassq  "6" x) nil)))
-
-(flet ((a () (list '(1 . 2) 3 '(4 . 5))))
-  (Assert (let* ((x (a)) (y (remassoc  1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-  (Assert (let* ((x (a)) (y (remassq   1 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-  (Assert (let* ((x (a)) (y (remrassoc 1 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  1 x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  2 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   2 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc 2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-  (Assert (let* ((x (a)) (y (remrassq  2 x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-
-  (Assert (let* ((x (a)) (y (remassoc  3 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   3 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc 3 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  3 x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
-  (Assert (let* ((x (a)) (y (remassq   4 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
-  (Assert (let* ((x (a)) (y (remrassoc 4 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  4 x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  5 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   5 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc 5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
-  (Assert (let* ((x (a)) (y (remrassq  5 x))) (and (eq x y) (equal y '((1 . 2) 3)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  6 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   6 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc 6 x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  6 x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (delete     3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-  (Assert (let* ((x (a)) (y (delq       3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delete 3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delq   3 x))) (and (eq x y) (equal y '((1 . 2) (4 . 5))))))
-
-  (Assert (let* ((x (a)) (y (delete     '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-  (Assert (let* ((x (a)) (y (delq       '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
-  (Assert (let* ((x (a)) (y (old-delete '(1 . 2) x))) (and (not (eq x y)) (equal y '(3 (4 . 5))))))
-  (Assert (let* ((x (a)) (y (old-delq   '(1 . 2) x))) (and      (eq x y)  (equal y (a)))))
-  )
-
-
-
-(flet ((a () (list '("1" . "2") "3" '("4" . "5"))))
-  (Assert (let* ((x (a)) (y (remassoc  "1" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
-  (Assert (let* ((x (a)) (y (remassq   "1" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc "1" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  "1" x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  "2" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   "2" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc "2" x))) (and (not (eq x y)) (equal y '("3" ("4" . "5"))))))
-  (Assert (let* ((x (a)) (y (remrassq  "2" x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  "3" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   "3" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc "3" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  "3" x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  "4" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
-  (Assert (let* ((x (a)) (y (remassq   "4" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc "4" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  "4" x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  "5" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   "5" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc "5" x))) (and (eq x y) (equal y '(("1" . "2") "3")))))
-  (Assert (let* ((x (a)) (y (remrassq  "5" x))) (and (eq x y) (equal y (a)))))
-
-  (Assert (let* ((x (a)) (y (remassoc  "6" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remassq   "6" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassoc "6" x))) (and (eq x y) (equal y (a)))))
-  (Assert (let* ((x (a)) (y (remrassq  "6" x))) (and (eq x y) (equal y (a))))))
-
-;;-----------------------------------------------------
-;; function-max-args, function-min-args
-;;-----------------------------------------------------
-(defmacro check-function-argcounts (fun min max)
-  `(progn
-     (Assert (eq (function-min-args ,fun) ,min))
-     (Assert (eq (function-max-args ,fun) ,max))))
-
-(check-function-argcounts 'prog1 1 nil)         ; special form
-(check-function-argcounts 'command-execute 1 3)	; normal subr
-(check-function-argcounts 'funcall 1 nil)       ; `MANY' subr
-(check-function-argcounts 'garbage-collect 0 0) ; no args subr
-
-;; Test interpreted and compiled functions
-(loop for (arglist min max) in
-  '(((arg1 arg2 &rest args) 2 nil)
-    ((arg1 arg2 &optional arg3 arg4) 2 4)
-    ((arg1 arg2 &optional arg3 arg4 &rest args) 2 nil)
-    (() 0 0))
-  do
-  (eval
-   `(progn
-      (defun test-fun ,arglist nil)
-      (check-function-argcounts '(lambda ,arglist nil) ,min ,max)
-      (check-function-argcounts (byte-compile '(lambda ,arglist nil)) ,min ,max))))
-
-;;-----------------------------------------------------
-;; Detection of cyclic variable indirection loops
-;;-----------------------------------------------------
-(fset 'test-sym1 'test-sym1)
-(Check-Error cyclic-function-indirection (test-sym1))
-
-(fset 'test-sym1 'test-sym2)
-(fset 'test-sym2 'test-sym1)
-(Check-Error cyclic-function-indirection (test-sym1))
-(fmakunbound 'test-sym1) ; else macroexpand-internal infloops!
-(fmakunbound 'test-sym2)
-
-;;-----------------------------------------------------
-;; Test `type-of'
-;;-----------------------------------------------------
-(Assert (eq (type-of load-path) 'cons))
-(Assert (eq (type-of obarray) 'vector))
-(Assert (eq (type-of 42) 'integer))
-(Assert (eq (type-of ?z) 'character))
-(Assert (eq (type-of "42") 'string))
-(Assert (eq (type-of 'foo) 'symbol))
-(Assert (eq (type-of (selected-device)) 'device))
--- a/tests/automated/test-harness.el	Mon Aug 13 11:07:11 2007 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,367 +0,0 @@
-;; test-harness.el --- Run Emacs Lisp test suites.
-
-;;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: Martin Buchholz
-;; Keywords: testing
-
-;; This file is part of XEmacs.
-
-;; XEmacs is free software; you can redistribute it and/or modify it
-;; under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; XEmacs is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: Not in FSF
-
-;;; Commentary:
-
-;;; A test suite harness for testing XEmacs.
-;;; The actual tests are in other files in this directory.
-;;; Basically you just create files of emacs-lisp, and use the
-;;; Assert, Check-Error, and Check-Message functions to create tests.
-;;; You run the tests using M-x test-emacs-test-file,
-;;; or $(EMACS) -l .../test-harness.el -f batch-test-emacs file ...
-;;; which is run for you by the `make check' target in the top-level Makefile.
-
-(require 'bytecomp)
-
-(defvar test-harness-verbose
-  (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
-  "*Non-nil means print messages describing progress of emacs-tester.")
-
-(defvar test-harness-current-file nil)
-
-(defvar emacs-lisp-file-regexp (purecopy "\\.el$")
-  "*Regexp which matches Emacs Lisp source files.")
-
-;;;###autoload
-(defun test-emacs-test-file (filename)
-  "Test a file of Lisp code named FILENAME.
-The output file's name is made by appending `c' to the end of FILENAME."
-  (interactive
-   (let ((file buffer-file-name)
-	 (file-name nil)
-	 (file-dir nil))
-     (and file
-	  (eq (cdr (assq 'major-mode (buffer-local-variables)))
-	      'emacs-lisp-mode)
-	  (setq file-name (file-name-nondirectory file)
-		file-dir (file-name-directory file)))
-     (list (read-file-name "Test file: " file-dir nil nil file-name))))
-  ;; Expand now so we get the current buffer's defaults
-  (setq filename (expand-file-name filename))
-
-  ;; If we're testing a file that's in a buffer and is modified, offer
-  ;; to save it first.
-  (or noninteractive
-      (let ((b (get-file-buffer (expand-file-name filename))))
-	(if (and b (buffer-modified-p b)
-		 (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
-	    (save-excursion (set-buffer b) (save-buffer)))))
-
-  (if (or noninteractive test-harness-verbose)
-      (message "Testing %s..." filename))
-  (let ((test-harness-current-file filename)
-	input-buffer)
-    (save-excursion
-      (setq input-buffer (get-buffer-create " *Test Input*"))
-      (set-buffer input-buffer)
-      (erase-buffer)
-      (insert-file-contents filename)
-      ;; Run hooks including the uncompression hook.
-      ;; If they change the file name, then change it for the output also.
-      (let ((buffer-file-name filename)
-	    (default-major-mode 'emacs-lisp-mode)
-	    (enable-local-eval nil))
-        (normal-mode)
-        (setq filename buffer-file-name)))
-    (test-harness-from-buffer input-buffer filename)
-    (kill-buffer input-buffer)
-    ))
-
-(defun test-harness-read-from-buffer (buffer)
-  "Read forms from BUFFER, and turn it into a lambda test form."
-  (let ((body nil))
-    (goto-char (point-min) buffer)
-    (condition-case error-info
-	(while t
-	  (setq body (cons (read buffer) body)))
-      (end-of-file nil)
-      (error
-       (princ "Unexpected error %S reading forms from buffer\n" error-info)))
-    `(lambda ()
-       (defvar passes)
-       (defvar assertion-failures)
-       (defvar no-error-failures)
-       (defvar wrong-error-failures)
-       (defvar missing-message-failures)
-       (defvar other-failures)
-
-       (defvar unexpected-test-suite-failure)
-       (defvar trick-optimizer)
-
-       ,@(nreverse body))))
-
-(defun test-harness-from-buffer (inbuffer filename)
-  "Run tests in buffer INBUFFER, visiting FILENAME."
-  (defvar trick-optimizer)
-  (let ((passes 0)
-	(assertion-failures 0)
-	(no-error-failures 0)
-	(wrong-error-failures 0)
-	(missing-message-failures 0)
-	(other-failures 0)
-
-	(trick-optimizer nil)
-	(unexpected-test-suite-failure nil)
-	(debug-on-error t))
-    (with-output-to-temp-buffer "*Test-Log*"
-
-      (defmacro Assert (assertion)
-	`(condition-case error-info
-	     (progn
-	       (assert ,assertion)
-	       (princ (format "PASS: %S" (quote ,assertion)))
-	       (terpri)
-	       (incf passes))
-	   (cl-assertion-failed
-	    (princ (format "FAIL: Assertion failed: %S\n" (quote ,assertion)))
-	    (incf assertion-failures))
-	   (t (princ (format "FAIL: %S ==> error: %S\n" (quote ,assertion) error-info))
-	      (incf other-failures)
-	      )))
-
-      (defmacro Check-Error (expected-error &rest body)
-	(let ((quoted-body (if (= 1 (length body))
-			       `(quote ,(car body)) `(quote (progn ,@body)))))
-	  `(condition-case error-info
-	       (progn
-		 (setq trick-optimizer (progn ,@body))
-		 (princ (format "FAIL: %S executed successfully, but expected error %S\n"
-				,quoted-body
-				',expected-error))
-		 (incf no-error-failures))
-	     (,expected-error
-	      (princ (format "PASS: %S ==> error %S, as expected\n"
-			     ,quoted-body ',expected-error))
-	      (incf passes))
-	     (error
-	      (princ (format "FAIL: %S ==> expected error %S, got error %S instead\n"
-			     ,quoted-body ',expected-error error-info))
-	      (incf wrong-error-failures)))))
-
-      (defmacro Check-Error-Message (expected-error expected-error-regexp &rest body)
-	(let ((quoted-body (if (= 1 (length body))
-			       `(quote ,(car body)) `(quote (progn ,@body)))))
-	  `(condition-case error-info
-	       (progn
-		 (setq trick-optimizer (progn ,@body))
-		 (princ (format "FAIL: %S executed successfully, but expected error %S\n"
-				,quoted-body
-				',expected-error))
-		 (incf no-error-failures))
-	     (,expected-error
-	      (let ((error-message (second error-info)))
-		(if (string-match ,expected-error-regexp error-message)
-		    (progn
-		      (princ (format "PASS: %S ==> error %S %S, as expected\n"
-				     ,quoted-body error-message ',expected-error))
-		      (incf passes))
-		  (princ (format "FAIL: %S ==> got error %S as expected, but error message %S did not match regexp %S\n"
-				 ,quoted-body ',expected-error error-message ,expected-error-regexp))
-		  (incf wrong-error-failures))))
-	     (error
-	      (princ (format "FAIL: %S ==> expected error %S, got error %S instead\n"
-			     ,quoted-body ',expected-error error-info))
-	      (incf wrong-error-failures)))))
-
-
-      (defmacro Check-Message (expected-message-regexp &rest body)
-	(let ((quoted-body (if (= 1 (length body))
-			       `(quote ,(car body)) `(quote (progn ,@body)))))
-	  `(let ((messages ""))
-	     (defadvice message (around collect activate)
-	       (defvar messages)
-	       (let ((msg-string (apply 'format (ad-get-args 0))))
-		 (setq messages (concat messages msg-string))
-		 msg-string))
-	     (condition-case error-info
-		 (progn
-		   (setq trick-optimizer (progn ,@body))
-		   (if (string-match ,expected-message-regexp messages)
-		       (progn
-			 (princ (format "PASS: %S ==> value %S, message %S, matching %S, as expected\n"
-					,quoted-body trick-optimizer messages ',expected-message-regexp))
-			 (incf passes))
-		     (princ (format "FAIL: %S ==> value %S, message %S, NOT matching expected %S\n"
-				    ,quoted-body  trick-optimizer messages ',expected-message-regexp))
-		     (incf missing-message-failures)))
-	       (error
-		(princ (format "FAIL: %S ==> unexpected error %S\n"
-			       ,quoted-body error-info))
-		(incf other-failures)))
-	     (ad-unadvise 'message))))
-
-      (defmacro Ignore-Ebola (&rest body)
-	`(let ((debug-issue-ebola-notices -42)) ,@body))
-
-      (defun Int-to-Marker (pos)
-	(save-excursion
-	  (set-buffer standard-output)
-	  (save-excursion
-	    (goto-char pos)
-	    (point-marker))))
-
-      (princ "Testing Interpreted Lisp\n\n")
-      (condition-case error-info
-	  (funcall (test-harness-read-from-buffer inbuffer))
-	(error
-	 (setq unexpected-test-suite-failure t)
-	 (princ (format "Unexpected error %S while executing interpreted code\n"
-		error-info))
-	 (message "Unexpected error %S while executing interpreted code." error-info)
-	 (message "Test suite execution aborted." error-info)
-	 ))
-      (princ "\nTesting Compiled Lisp\n\n")
-      (let (code)
-	(condition-case error-info
-	    (setq code (let ((byte-compile-warnings nil))
-			 (byte-compile (test-harness-read-from-buffer inbuffer))))
-	  (error
-	   (princ (format "Unexpected error %S while byte-compiling code\n"
-			  error-info))))
-	(condition-case error-info
-	    (if code (funcall code))
-	  (error
-	   (princ (format "Unexpected error %S while executing byte-compiled code\n"
-			  error-info))
-	   (message "Unexpected error %S while executing byte-compiled code." error-info)
-	   (message "Test suite execution aborted." error-info)
-	   )))
-      (princ "\nSUMMARY:\n")
-      (princ (format "\t%5d passes\n" passes))
-      (princ (format "\t%5d assertion failures\n" assertion-failures))
-      (princ (format "\t%5d errors that should have been generated, but weren't\n" no-error-failures))
-      (princ (format "\t%5d wrong-error failures\n" wrong-error-failures))
-      (princ (format "\t%5d missing-message failures\n" missing-message-failures))
-      (princ (format "\t%5d other failures\n" other-failures))
-      (let* ((total (+ passes
-		       assertion-failures
-		       no-error-failures
-		       wrong-error-failures
-		       missing-message-failures
-		       other-failures))
-	     (basename (file-name-nondirectory filename))
-	     (summary-msg
-	      (if (> total 0)
-		  (format "%s: %d of %d (%d%%) tests successful."
-			  basename passes total (/ (* 100 passes) total))
-		(format "%s: No tests run" basename))))
-	(message "%s" summary-msg))
-      (when unexpected-test-suite-failure
-	(message "Test suite execution failed unexpectedly."))
-      (fmakunbound 'Assert)
-      (fmakunbound 'Check-Error)
-      (fmakunbound 'Ignore-Ebola)
-      (fmakunbound 'Int-to-Marker)
-      )))
-
-(defvar test-harness-results-point-max nil)
-(defmacro displaying-emacs-test-results (&rest body)
-  `(let ((test-harness-results-point-max test-harness-results-point-max))
-     ;; Log the file name.
-     (test-harness-log-file)
-     ;; Record how much is logged now.
-     ;; We will display the log buffer if anything more is logged
-     ;; before the end of BODY.
-     (or test-harness-results-point-max
-	 (save-excursion
-	   (set-buffer (get-buffer-create "*Test-Log*"))
-	   (setq test-harness-results-point-max (point-max))))
-     (unwind-protect
-	 (condition-case error-info
-	     (progn ,@body)
-	   (error
-	    (test-harness-report-error error-info)))
-       (save-excursion
-	 ;; If there were compilation warnings, display them.
-	 (set-buffer "*Test-Log*")
-	 (if (= test-harness-results-point-max (point-max))
-	     nil
-	   (if temp-buffer-show-function
-	       (let ((show-buffer (get-buffer-create "*Test-Log-Show*")))
-		 (save-excursion
-		   (set-buffer show-buffer)
-		   (setq buffer-read-only nil)
-		   (erase-buffer))
-		 (copy-to-buffer show-buffer
-				 (save-excursion
-				   (goto-char test-harness-results-point-max)
-				   (forward-line -1)
-				   (point))
-				 (point-max))
-		 (funcall temp-buffer-show-function show-buffer))
-              (select-window
-               (prog1 (selected-window)
-                 (select-window (display-buffer (current-buffer)))
-                 (goto-char test-harness-results-point-max)
-                 (recenter 1)))))))))
-
-(defun batch-test-emacs-1 (file)
-  (condition-case error-info
-      (progn (test-emacs-test-file file) t)
-    (error
-     (princ ">>Error occurred processing ")
-     (princ file)
-     (princ ": ")
-     (display-error error-info nil)
-     (terpri)
-     nil)))
-
-(defun batch-test-emacs ()
-  "Run `test-harness' on the files remaining on the command line.
-Use this from the command line, with `-batch';
-it won't work in an interactive Emacs.
-Each file is processed even if an error occurred previously.
-For example, invoke \"xemacs -batch -f batch-test-emacs tests/*.el\""
-  ;; command-line-args-left is what is left of the command line (from
-  ;; startup.el)
-  (defvar command-line-args-left)	;Avoid 'free variable' warning
-  (defvar debug-issue-ebola-notices)
-  (if (not noninteractive)
-      (error "`batch-test-emacs' is to be used only with -batch"))
-  (let ((error nil))
-    (loop for file in command-line-args-left
-      do
-      (if (file-directory-p (expand-file-name file))
-	  (let ((files (directory-files file))
-		source)
-	    (while files
-	      (if (and (string-match emacs-lisp-file-regexp (car files))
-		       (not (auto-save-file-name-p (car files)))
-		       (setq source (expand-file-name
-				     (car files)
-				     file))
-		       (if (null (batch-test-emacs-1 source))
-			   (setq error t)))
-		  (setq files (cdr files)))))
-	(if (null (batch-test-emacs-1 file))
-	    (setq error t))))
-    ;;(message "%s" (buffer-string nil nil "*Test-Log*"))
-    (message "Done")
-    (kill-emacs (if error 1 0))))
-
-(provide 'test-harness)
-
-;;; test-harness.el ends here
--- a/version.sh	Mon Aug 13 11:07:11 2007 +0200
+++ b/version.sh	Mon Aug 13 11:07:39 2007 +0200
@@ -1,8 +1,8 @@
 #!/bin/sh
 emacs_major_version=21
 emacs_minor_version=2
-emacs_beta_version=5
-xemacs_codename="Aphrodite"
+emacs_beta_version=6
+xemacs_codename="Apollo"
 infodock_major_version=4
 infodock_minor_version=0
 infodock_build_version=1