🚀 go-pugleaf

      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