acuff@SUMEX-AIM.STANFORD.EDU (Richard Acuff) (02/12/91)
EXPLORER (TM) BUG REPORT
DATE-TIME : 11-Feb-91 23:23:16
PRIORITY : M (H)igh (M)edium (L)ow
TYPE : B (B)ug (D)esign (M)anual
MACHINE-TYPE: M (E)xplorer (M)icroExplorer
DESCRIPTION-OF-PROBLEM:
NIL doesn't get exported via calls to EXPORT, as demonstrated in the
following:
(defpackage test1)
(export '(t nil) 'test1)
(defpackage test2 (:use test1))
(eq 'test1:t 'test2:t ) ;==> T, as it should be
(eq 'test1:nil 'test2:nil) ;==> NIL which is wrong
WORK-AROUND:
The following one-line patch to EXPORT (commented with RDA) fixes this
problem. The def'n of PARSE-PACKAGE-ARGUMENT is so the patch can be
compiled.
SYS:
(Defmacro PARSE-STRING-ARGUMENT (string)
`(IF (STRINGP ,string)
(IF (EQ (ARRAY-TYPE ,string) 'ART-FAT-STRING) ;; watch out for fonted strings
(STRING-REMOVE-FONTS ,string)
,string)
(STRING ,string)))
SYS:
(Defun EXPORT (symbols &OPTIONAL pkg)
"Makes SYMBOLS external in package PKG.
If the symbols are not already present in PKG, they are imported first.
Error if this causes a name conflict in any package that USEs PKG."
(LET ((pkg (PARSE-PACKAGE-ARGUMENT pkg)) ;; verify package argument
(export-list (IF (LISTP symbols) symbols (LIST symbols)))) ;; coerce <symbols> to a list
(UNLESS (EVERY #'SYMBOLP export-list) ;; verify all are symbols - complain otherwise
(ERROR t "the export list contains non-symbols: ~s" (REMOVE-IF #'SYMBOLP export-list)))
(LET ((real-export-list ;; prepare to punt symbols already exported
(REMOVE-IF ;; -- this is worthwhile since files with 'exports' are often re-compiled
#'(Lambda (sym)
(MULTIPLE-VALUE-BIND (csym found)
(FIND-SYMBOL (symbol-name sym) pkg)
(AND (EQ found :external) (EQ sym csym))))
export-list))
(used-by-list (PACK-USED-BY-LIST pkg)))
(TAGBODY try-next-sym
(DOLIST (sym real-export-list)
(WHEN used-by-list
(LET ((set-of-directly-conflicting-symbols nil)
(set-of-inherited-conflicting-symbols nil)
(name (SYMBOL-NAME sym)))
(DOLIST (p used-by-list) ;; for each package p using pkg
(MULTIPLE-VALUE-BIND (csym found) ;; look for a conflict
(FIND-SYMBOL name p)
(WHEN (AND found
(NEQ sym csym)
(NOT (MEMBER csym (pack-shadowing-symbols p) :test #'eq)))
(IF (EQ found :inherited)
(PUSH (CONS csym p) set-of-inherited-conflicting-symbols)
(PUSH (CONS csym p) set-of-directly-conflicting-symbols)))))
;; Handle name conflicts
(COND ((AND set-of-directly-conflicting-symbols
set-of-inherited-conflicting-symbols)
(signal-proceed-case ((ignore) 'eh:name-conflict
(format t "~%Attempting to export ~s from the ~a package ~
would introduce the following name conflicts:" sym (package-name pkg))
sym
(package-name pkg)
:export
(cons set-of-directly-conflicting-symbols
set-of-inherited-conflicting-symbols)
(progn (dolist (pair set-of-directly-conflicting-symbols)
(format t "~&~10t~s is present in the ~a package."
(car pair) (package-name (cdr pair))))
(dolist (pair set-of-inherited-conflicting-symbols)
(format t "~&~10t~? is accessible by inheritance ~
in the ~a package."
"~a:~a"
`(,(multiple-value-bind (ignore ignore pack)
(find-symbol (symbol-name (car pair))
(cdr pair))
(package-name pack))
,(car pair))
(package-name (cdr pair))))))
(:export-both-conflict-types nil)
(:skip (go try-next-sym))
(:skip-all (return-from export t))))
(set-of-directly-conflicting-symbols
(signal-proceed-case ((ignore) 'eh:name-conflict
(format t "~%Attempting to export ~s from the ~a package ~
would introduce the following name conflicts:" sym (package-name pkg))
sym
(package-name pkg)
:export
set-of-directly-conflicting-symbols
(dolist (pair set-of-directly-conflicting-symbols)
(format t "~&~10t~s is present in the ~a package."
(car pair) (package-name (cdr pair)))))
(:export-present nil)
(:unintern-all nil)
(:shadow-all nil)
(:skip (go try-next-sym))
(:skip-all (return-from export t))))
(set-of-inherited-conflicting-symbols
(signal-proceed-case ((ignore) 'eh:name-conflict
(format t "~%Attempting to export ~s from the ~a package ~
would introduce the following name conflicts:" sym (package-name pkg))
sym
(package-name pkg)
:export
set-of-inherited-conflicting-symbols
(dolist (pair set-of-inherited-conflicting-symbols)
(format t "~&~10t~? is accessible by inheritance ~
in the ~a package."
"~a:~a"
`(,(multiple-value-bind (ignore ignore pack)
(find-symbol (symbol-name (car pair))
(cdr pair))
(package-name pack))
,(car pair))
(package-name (cdr pair)))))
(:export-accessible-by-inheritance nil)
(:skip (go try-next-sym))
(:skip-all (return-from export t))))
(t nil))
))
;; If we get here, then proceed with exporting <sym>.
;RDA: Put SYM into a list when it's NIL
(IMPORT (or sym (list sym)) pkg)
(EXTERNALIZE sym pkg)
try-next-sym
))
t)))
TI Number:
Submitter: Acuff
CUSTOMER-ID: 170
NAME : Richard Acuff
LOCATION : WR C101 Acuff
ADDRESS : 701 Welch Rd., Bldg. C, Stanford, CA 94305
PHONE : (415) 723-2225
NET-ADDRESS: Richard Acuff <acuff@SUMEX-AIM.Stanford.EDU>
SOFTWARE-CONFIGURATION:
With SYSTEM 6.41, GC 6.7, VIRTUAL-MEMORY 6.3, MICRONET 6.0,
MICRONET-COMM 6.4, DISK-IO 6.4, DISK-LABEL 6.1, BASIC-PATHNAME 6.5,
MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8,
BASIC-FILE 6.15, RPC 6.2, NFS-MX 6.9, EH 6.8, MAKE-SYSTEM 6.5,
MEMORY-AUX 6.0, COMPILER 6.18, TV 6.32, NVRAM 6.4, UCL 6.1,
INPUT-EDITOR 6.1, MACTOOLBOX 2.25, METER 6.2, ZWEI 6.28, DEBUG-TOOLS 6.5,
WINDOW-MX 6.12, PRINTER 6.8, MAC-PRINTER-TYPES 6.2, CLIPBOARD 6.1,
TI-CLOS 6.53, CLEH 6.5, NETWORK-PATHNAME 6.2, NETWORK-NAMESPACE 6.1,
DATALINK 6.0, CHAOSNET 6.9, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3,
DATALINK-DISPLAYS 6.0, MX-DATALINK 6.1, NAMESPACE-EDITOR 6.7, IP 3.65,
NFS-MX-SERVER 6.0, MX-SERIAL 6.2, PRINTER-TYPES 6.2, IMAGEN 6.1,
MAIL-DAEMON 6.6, MAIL-READER 6.9, TELNET 6.1, VT100 6.0,
STREAMER-TAPE 6.6, DECNET 1.72, VISIDOC 6.7, PROFILE 6.3,
Experimental KSL-PATCHES 10.3, microcode 195, Band Name: 6.1(41),
KSL9 10.2, 17-Jan, Host: KSL-Mac-62
HARDWARE-CONFIGURATION:
microExplorer, Microcode MX-UCODE 195 for the Explorer Lisp Microprocessor