--- /dev/null
+/* system description file for mingw32.
+ Copyright (C) 1993, 1994, 1995, 1999 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs 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.
+
+GNU Emacs 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. */
+
+/* based on cygwin32.h by Andy Piper <andy@xemacs.org> */
+
+#ifndef WINDOWSNT
+#define WINDOWSNT
+#endif
+
+#ifndef DOS_NT
+#define DOS_NT /* MSDOS or WINDOWSNT */
+#endif
+
+#define PBS_SMOOTH 0x01
+
+#ifdef HAVE_MS_WINDOWS
+#define HAVE_NTGUI
+#define HAVE_FACES
+#endif
+
+#ifndef ORDINARY_LINK
+#define ORDINARY_LINK
+#endif
+
+#define C_SWITCH_SYSTEM "-mno-cygwin -Wno-sign-compare -fno-caller-saves -Int/inc -I../nt/inc -DWINDOWSNT"
+#define LIBS_SYSTEM "-mno-cygwin -lwinmm -lwsock32"
+
+#define TEXT_START -1
+#define TEXT_END -1
+#define DATA_END -1
+#define HEAP_IN_DATA
+#define UNEXEC "unexcw.o"
+
+#define TIME_ONESHOT 0
+#define TIME_PERIODIC 1
+#define LOCALE_USE_CP_ACP 0x40000000
+#define SHGFI_EXETYPE 0x2000
+#define NSIG 23
+
+/* translate NT world unexec stuff to our a.out definitions */
+
+#define strnicmp strncasecmp
+/* #ifndef HAVE_SOCKETS */
+#define HAVE_SOCKETS
+/* #endif */
+#define OBJECTS_SYSTEM ntplay.o nt.o ntheap.o ntproc.o dired-msw.o
+#define HAVE_NATIVE_SOUND
+
+#undef MAIL_USE_SYSTEM_LOCK
+#define MAIL_USE_POP
+#define HAVE_MSW_C_DIRED
+
+/* Define NO_ARG_ARRAY if you cannot take the address of the first of a
+ * group of arguments and treat it as an array of the arguments. */
+
+#define NO_ARG_ARRAY
+
+/* Define WORD_MACHINE if addresses and such have
+ * to be corrected before they can be used as byte counts. */
+
+#define WORD_MACHINE
+
+/* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend
+ the 24-bit bit field into an int. In other words, if bit fields
+ are always unsigned.
+
+ If you use NO_UNION_TYPE, this flag does not matter. */
+
+#define EXPLICIT_SIGN_EXTEND
+/* System calls that are encapsulated */
+#define ENCAPSULATE_RENAME
+#define ENCAPSULATE_OPEN
+#define ENCAPSULATE_FOPEN
+#define ENCAPSULATE_MKDIR
+
+/* Data type of load average, as read out of kmem. */
+
+#define LOAD_AVE_TYPE long
+
+/* Convert that into an integer that is 100 for a load average of 1.0 */
+
+#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE)
+
+/* Define VIRT_ADDR_VARIES if the virtual addresses of
+ pure and impure space as loaded can vary, and even their
+ relative order cannot be relied on.
+
+ Otherwise Emacs assumes that text space precedes data space,
+ numerically. */
+
+/* Text does precede data space, but this is never a safe assumption. */
+#define VIRT_ADDR_VARIES
+
+/* set this if you have a new version of cygwin
+#define DATA_SEG_BITS 0x10000000
+*/
+
+/* If you are compiling with a non-C calling convention but need to
+ declare vararg routines differently, put it here */
+#define _VARARGS_ __cdecl
+
+/* If you are providing a function to something that will call the
+ function back (like a signal handler and signal, or main) its calling
+ convention must be whatever standard the libraries expect */
+#define _CALLBACK_ __cdecl
+
+/* SYSTEM_TYPE should indicate the kind of system you are using.
+ It sets the Lisp variable system-type. */
+
+#define SYSTEM_TYPE "windows-nt"
+
+#define NO_MATHERR
+
+/* define MAIL_USE_FLOCK if the mailer uses flock
+ to interlock access to /usr/spool/mail/$USER.
+ The alternative is that a lock file named
+ /usr/spool/mail/$USER.lock. */
+
+/* If the character used to separate elements of the executable path
+ is not ':', #define this to be the appropriate character constant. */
+#define SEPCHAR ';'
+
+/* ============================================================ */
+
+/* Here, add any special hacks needed
+ to make Emacs work on this system. For example,
+ you might define certain system call names that don't
+ exist on your system, or that do different things on
+ your system and must be used only through an encapsulation
+ (Which you should place, by convention, in sysdep.c). */
+
+/* Define this to be the separator between devices and paths */
+#define DEVICE_SEP ':'
+
+#define DIRECTORY_SEP '\\'
+
+/* The null device on Windows NT. */
+#define NULL_DEVICE "NUL:"
+#define EXEC_SUFFIXES ".exe:.com:.bat:.cmd:"
+/* We'll support either convention on NT. */
+#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\')
+#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))
+#define EXEC_SUFFIXES ".exe:.com:.bat:.cmd:"
+
+/* We need a little extra space, see ../../lisp/loadup.el */
+#define SYSTEM_PURESIZE_EXTRA 15000
+
+#ifndef NOT_C_CODE
+#include <stdlib.h>
+#include <mingw32/process.h>
+#define mkdir __mkdir
+#include <dir.h>
+#undef mkdir
+#ifdef HAVE_CYGWIN_VERSION_H
+#include <cygwin/version.h>
+#endif
+
+typedef unsigned int MMRESULT;
+typedef struct timecaps_tag {
+ unsigned int wPeriodMin;
+ unsigned int wPeriodMax;
+} TIMECAPS;
+
+/* IO calls that are emulated or shadowed */
+#define pipe sys_pipe
+int sys_pipe (int * phandles);
+
+#ifndef HAVE_X_WINDOWS
+#define sleep sys_sleep
+void sleep (int seconds);
+#endif
+
+/* subprocess calls that are emulated */
+#define spawnve sys_spawnve
+int spawnve (int mode, CONST char *cmdname,
+ CONST char * CONST *argv, CONST char *CONST *envp);
+
+#define wait sys_wait
+int wait (int *status);
+
+#define kill sys_kill
+int kill (int pid, int sig);
+
+/* map to MSVC names */
+#define popen _popen
+#define pclose _pclose
+
+/* Encapsulation of system calls */
+#ifndef DONT_ENCAPSULATE
+#define getpid sys_getpid
+int getpid (void);
+#endif
+
+#define DONT_USE_LITOUT
+
+/* Random global functions called everywhere. Implemented in nt.c */
+/* #### Most of these are FSFisms and must be avoided */
+/* #### All of these are FSFisms and must be avoided */
+void dostounix_filename (char *p);
+void unixtodos_filename (char *p);
+int crlf_to_lf (int n, unsigned char *buf, unsigned int *lf_count);
+
+char *getwd (char *dir);
+
+void *sbrk (unsigned long increment);
+
+struct passwd;
+struct passwd *getpwuid (int uid);
+struct passwd *getpwnam (const char *name);
+int getuid ();
+int geteuid ();
+int getgid (void);
+int getegid ();
+#define _timeb timeb
+
+/* Stuff that gets set wrongly or otherwise */
+#define HAVE_SETITIMER
+#define HAVE_GETTIMEOFDAY
+#define HAVE_SELECT
+/*#define HAVE_STRUCT_UTIMBUF*/
+
+#undef GETTIMEOFDAY_ONE_ARGUMENT
+#undef HAVE_SYS_WAIT_H
+#undef HAVE_TERMIOS
+#undef SYSV_SYSTEM_DIR
+
+/* We now have emulation for some signals */
+#define HAVE_SIGHOLD
+#define sigset(s,h) msw_sigset(s,h)
+#define sighold(s) msw_sighold(s)
+#define sigrelse(s) msw_sigrelse(s)
+#define sigpause(s) msw_sigpause(s)
+#define signal sigset
+
+/* Defines that we need that aren't in the standard signal.h */
+#define SIGHUP 1 /* Hang up */
+#define SIGQUIT 3 /* Quit process */
+#define SIGKILL 9 /* Die, die die */
+#define SIGALRM 14 /* Alarm */
+#define SIGPROF 29 /* Profiling timer exp */
+
+#ifndef MAXPATHLEN
+#define MAXPATHLEN _MAX_PATH
+#endif
+
+/* For integration with MSDOS support. */
+#define getdisk() (_getdrive () - 1)
+#define getdefdir(_drv, _buf) _getdcwd (_drv, _buf, MAXPATHLEN)
+#endif
+
+/* Define for those source files that do not include enough NT
+ system files. */
+#ifndef NULL
+#ifdef __cplusplus
+#define NULL 0
+#else
+#define NULL ((void *)0)
+#endif
+#endif
+
+/* Define process implementation */
+#define HAVE_WIN32_PROCESSES
+
+/* ============================================================ */
+
--- /dev/null
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Hrvoje Niksic <hniksic@srce.hr>
+;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Created: 1999
+;; 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.
+
+;;; Commentary:
+
+;; Test symbols operations.
+;; 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))))
+
+
+(defun ts-fresh-symbol-name (name)
+ "Return a variant of NAME (a string) that is not interned."
+ (when (intern-soft name)
+ (let ((count 1)
+ (orig name))
+ (while (progn
+ (setq name (format "%s-%d" orig count))
+ (intern-soft name))
+ (incf count))))
+ name)
+
+;;-----------------------------------------------------
+;; Creating, reading, and printing symbols
+;;-----------------------------------------------------
+
+(dolist (name '("foo" "bar" ""
+ "something with space in it"
+ "a string with \0 in the middle."
+ "100" "10.0" "#<>[]]]];'\\';"
+ "!@#$%^^&*(()__"))
+ (let ((interned (intern name))
+ (uninterned (make-symbol name)))
+ (Assert (symbolp interned))
+ (Assert (symbolp uninterned))
+ (Assert (equal (symbol-name interned) name))
+ (Assert (equal (symbol-name uninterned) name))
+ (Assert (not (eq interned uninterned)))
+ (Assert (not (equal interned uninterned)))))
+
+(flet ((check-weak-list-unique (weak-list &optional reversep)
+ "Check that elements of WEAK-LIST are referenced only there."
+ (let ((len (length (weak-list-list weak-list))))
+ (Assert (not (zerop len)))
+ (garbage-collect)
+ (Assert (eq (length (weak-list-list weak-list))
+ (if (not reversep) 0 len))))))
+ (let ((weak-list (make-weak-list))
+ (gc-cons-threshold most-positive-fixnum))
+ ;; Symbols created with `make-symbol' and `gensym' should be fresh
+ ;; and not referenced anywhere else. We check that no other
+ ;; references are available using a weak list.
+ (eval
+ ;; This statement must not be run byte-compiled, or the values
+ ;; remain referenced on the bytecode interpreter stack.
+ '(set-weak-list-list weak-list (list (make-symbol "foo") (gensym "foo"))))
+ (check-weak-list-unique weak-list)
+
+ ;; Equivalent test for `intern' and `gentemp'.
+ (eval
+ '(set-weak-list-list weak-list
+ (list (intern (ts-fresh-symbol-name "foo"))
+ (gentemp (ts-fresh-symbol-name "bar")))))
+ (check-weak-list-unique weak-list 'not)))
+
+(Assert (not (intern-soft (make-symbol "foo"))))
+(Assert (not (intern-soft (gensym "foo"))))
+(Assert (intern-soft (intern (ts-fresh-symbol-name "foo"))))
+(Assert (intern-soft (gentemp (ts-fresh-symbol-name "bar"))))
+
+;; Reading a symbol should intern it automatically, unless the symbol
+;; is marked specially.
+(dolist (string (mapcar #'ts-fresh-symbol-name '("foo" "bar" "\\\0\\\1")))
+ (setq symbol (read string)
+ string (read (concat "\"" string "\"")))
+ (Assert (intern-soft string))
+ (Assert (intern-soft symbol))
+ (Assert (eq (intern-soft string) (intern-soft symbol))))
+
+(let ((fresh (read (concat "#:" (ts-fresh-symbol-name "foo")))))
+ (Assert (not (intern-soft fresh))))
+
+;; Check #N=OBJECT and #N# read syntax.
+(let* ((list (read "(#1=#:foo #1# #2=#:bar #2# #1# #2#)"))
+ (foo (nth 0 list))
+ (foo2 (nth 1 list))
+ (bar (nth 2 list))
+ (bar2 (nth 3 list))
+ (foo3 (nth 4 list))
+ (bar3 (nth 5 list)))
+ (Assert (symbolp foo))
+ (Assert (not (intern-soft foo)))
+ (Assert (equal (symbol-name foo) "foo"))
+ (Assert (symbolp bar))
+ (Assert (not (intern-soft bar)))
+ (Assert (equal (symbol-name bar) "bar"))
+
+ (Assert (eq foo foo2))
+ (Assert (eq foo2 foo3))
+ (Assert (eq bar bar2))
+ (Assert (eq bar2 bar3)))
+
+;; Check #N=OBJECT and #N# print syntax.
+(let* ((foo (make-symbol "foo"))
+ (bar (make-symbol "bar"))
+ (list (list foo foo bar bar foo bar)))
+ (let* ((print-gensym nil)
+ (printed-list (prin1-to-string list)))
+ (Assert (equal printed-list "(foo foo bar bar foo bar)")))
+ (let* ((print-gensym t)
+ (printed-list (prin1-to-string list)))
+ (Assert (equal printed-list "(#1=#:foo #1# #2=#:bar #2# #1# #2#)"))))
+
+;;-----------------------------------------------------
+;; Read-only symbols
+;;-----------------------------------------------------
+
+(Check-Error setting-constant
+ (set nil nil))
+(Check-Error setting-constant
+ (set t nil))
+
+;;-----------------------------------------------------
+;; Variable indirections
+;;-----------------------------------------------------
+
+(let ((foo 0)
+ (bar 1))
+ (defvaralias 'foo 'bar)
+ (Assert (eq foo bar))
+ (Assert (eq foo 1))
+ (Assert (eq (variable-alias 'foo) 'bar))
+ (defvaralias 'bar 'foo)
+ (Check-Error cyclic-variable-indirection
+ (symbol-value 'foo))
+ (Check-Error cyclic-variable-indirection
+ (symbol-value 'bar))
+ (defvaralias 'foo nil)
+ (Assert (eq foo 0))
+ (defvaralias 'bar nil)
+ (Assert (eq bar 1)))
+
+;;-----------------------------------------------------
+;; Keywords
+;;-----------------------------------------------------
+
+;;; Reading keywords
+
+;; In Elisp, a keyword is by definition a symbol beginning with `:'
+;; that is interned in the global obarray.
+
+;; In Elisp, a keyword is interned as any other symbol.
+(Assert (eq (read ":foo") (intern ":foo")))
+
+;; A keyword is self-quoting and evaluates to itself.
+(Assert (eq (eval (intern ":foo")) :foo))
+
+;; Keywords are recognized as such only if interned in the global
+;; obarray, and `keywordp' is aware of that.
+(Assert (keywordp :foo))
+(Assert (not (keywordp (intern ":foo" [0]))))
+
+;; Keywords used to be initialized at read-time, which resulted in
+;; (symbol-value (intern ":some-new-keyword")) signaling an error.
+;; Now we handle keywords at the time when the symbol is interned, so
+;; that (intern ":something) and (read ":something) will be
+;; equivalent. These tests check various operations on symbols that
+;; are guaranteed to be freshly interned.
+
+;; Interning a fresh keyword string should produce a regular
+;; keyword.
+(let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo"))
+ (fresh-keyword (intern fresh-keyword-name)))
+ (Assert (eq (symbol-value fresh-keyword) fresh-keyword))
+ (Assert (keywordp fresh-keyword)))
+
+;; Likewise, reading a fresh keyword string should produce a regular
+;; keyword.
+(let* ((fresh-keyword-name (ts-fresh-symbol-name ":foo"))
+ (fresh-keyword (read fresh-keyword-name)))
+ (Assert (eq (symbol-value fresh-keyword) fresh-keyword))
+ (Assert (keywordp fresh-keyword)))
+
+;;; Assigning to keywords
+
+;; You shouldn't be able to set its value to something bogus.
+(Check-Error setting-constant
+ (set :foo 5))
+
+;; But, for backward compatibility, setting to the same value is OK.
+(Assert
+ (eq (set :foo :foo) :foo))
+
+;; Playing games with `intern' shouldn't fool us.
+(Check-Error setting-constant
+ (set (intern ":foo" obarray) 5))
+(Assert
+ (eq (set (intern ":foo" obarray) :foo) :foo))
+
+;; But symbols not interned in the global obarray are not real
+;; keywords (in elisp):
+(Assert (eq (set (intern ":foo" [0]) 5) 5))
+
+;;; Printing keywords
+
+(let ((print-gensym t))
+ (Assert (equal (prin1-to-string :foo) ":foo"))
+ (Assert (equal (prin1-to-string (intern ":foo")) ":foo"))
+ (Assert (equal (prin1-to-string (intern ":foo" [0])) "#::foo")))
+
+(let ((print-gensym nil))
+ (Assert (equal (prin1-to-string :foo) ":foo"))
+ (Assert (equal (prin1-to-string (intern ":foo")) ":foo"))
+ (Assert (equal (prin1-to-string (intern ":foo" [0])) ":foo")))
+
+;; #### Add many more tests for printing and reading symbols, as well
+;; as print-gensym and print-gensym-alist!
+
+;;-----------------------------------------------------
+;; Magic symbols
+;;-----------------------------------------------------
+
+;; Magic symbols are almost totally unimplemented. However, a
+;; rudimentary subset of the functionality is being used to implement
+;; backward compatibility or clearer error messages for new features
+;; such as specifiers and glyphs. These tests try to test that
+;; working subset.
+
+(let ((mysym (make-symbol "test-symbol")))
+ (dontusethis-set-symbol-value-handler
+ mysym
+ 'set-value
+ (lambda (&rest args)
+ (throw 'test-tag args)))
+ (Assert (equal (catch 'test-tag
+ (set mysym 'foo))
+ `(,mysym (foo) set nil nil))))
+
+;; #### These two make XEmacs crash!
+
+;(let ((mysym (make-symbol "test-symbol")))
+; (dontusethis-set-symbol-value-handler
+; mysym
+; 'make-unbound
+; (lambda (&rest args)
+; (throw 'test-tag args)))
+; (Assert (equal (catch 'test-tag
+; (set mysym 'foo))
+; `(,mysym (foo) set nil nil))))
+
+;(let ((mysym (make-symbol "test-symbol")))
+; (dontusethis-set-symbol-value-handler
+; mysym
+; 'make-local
+; (lambda (&rest args)
+; (throw 'test-tag args)))
+; (Assert (equal (catch 'test-tag
+; (set mysym 'foo))
+; `(,mysym (foo) set nil nil))))
projects / chise / xemacs-chise.git.1 / commitdiff