From: tomo Date: Mon, 17 May 1999 09:44:07 +0000 (+0000) Subject: Initial revision X-Git-Tag: r21_2_14~2^2 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9e7c74cca7249ff7f98bc57a1f9c20c5d555f89c;p=chise%2Fxemacs-chise.git.1 Initial revision --- diff --git a/src/s/mingw32.h b/src/s/mingw32.h new file mode 100644 index 0000000..4f0fd96 --- /dev/null +++ b/src/s/mingw32.h @@ -0,0 +1,282 @@ +/* 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 */ + +#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 +#include +#define mkdir __mkdir +#include +#undef mkdir +#ifdef HAVE_CYGWIN_VERSION_H +#include +#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 + +/* ============================================================ */ + diff --git a/tests/automated/symbol-tests.el b/tests/automated/symbol-tests.el new file mode 100644 index 0000000..d8c680f --- /dev/null +++ b/tests/automated/symbol-tests.el @@ -0,0 +1,289 @@ +;; Copyright (C) 1999 Free Software Foundation, Inc. + +;; Author: Hrvoje Niksic +;; Maintainer: Hrvoje Niksic +;; 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))))