Did anyone answer thig guy?

[Scott.Fahlman@SEF-PMAX.SLISP.CS.CMU.EDU]

I haven't had time to think about whether his "bug" is for real.  Has
anyone else replied or even thought about this?

-- Scott


------- Forwarded Message

Return-Path: <cmucl-bugs-Request@B.GP.CS.CMU.EDU>
Received: from cs.cmu.edu by B.GP.CS.CMU.edu id aa13101; 18 Jul 91 10:35:17 EDT
Received: from liasun6.epfl.ch by CS.CMU.EDU id aa06903; 18 Jul 91 10:34:20 EDT
Received: by liasun6.epfl.ch (/\==/\ Smail3.1.21.1 #21.60)
	id <m0k0ZQi-0008OoC@liasun6.epfl.ch>; Thu, 18 Jul 91 16:34 MET DST
Message-Id: <m0k0ZQi-0008OoC@liasun6.epfl.ch>
Date: Thu, 18 Jul 91 16:34 MET DST
From: simon@liasun6.epfl.ch (Simon Leinen)
To: cmucl-bugs@CS.CMU.EDU
Subject: bug in CMU CL's symbol printer
Reply-to: simon@liasun6.epfl.ch
Full-Name: Simon Leinen

With *PRINT-ESCAPE* set, the printer must never print two distinct
symbols the same.  The following test file constructs a case where
CMUCL violates this rule: Package C uses package A which exports a
symbol FOO.  Then it SHADOWING-IMPORTs another symbol FOO from a
package B.  These two symbols are distinct, yet they print the same.
I think this bug was already in Spice Lisp.  Included are test runs
with CMUCL (SunOS alpha) and Allegro 4.0.1, and a suggested fix.
- -- 
Simon.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File Name:	  symbol-printer-test.lisp
;;; Description:  Exercise a bug in CMU CL's symbol printer
;;; Author:	  Simon Leinen (simon@liasun3)
;;; Date Created: 18-Jul-91
;;; RCS $Header$  
;;; RCS $Log$	  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "USER")

(let ((package-counter 0))
  (defun remove-package (name)
    (let ((x (find-package name)))
      (when x
	(rename-package x (format nil "removed-~D" package-counter))
	(incf package-counter)))))

(defun symbol-test ()
  (remove-package "A")
  (remove-package "B")
  (remove-package "C")
  (let ((a (make-package "A" :use '()))
	(b (make-package "B" :use '())))
    (let ((a1 (intern "FOO" a))
	  (b1 (intern "FOO" b)))
      (export (list a1) a)
      (export (list b1) b))
    (let ((c (make-package "C" :use '())))
      (use-package "A" c)
      (shadowing-import (list (find-symbol "FOO" b)) c)

      (let ((*package* (find-package "C"))
	    (*print-escape* t))
	(let ((foo-a (find-symbol "FOO" a))
	      (foo-b (find-symbol "FOO" b)))
	  (print foo-a)
	  (print foo-b)
	  (values foo-a foo-b))))))
- ------------------------------------------------------------------------------
Starting /usr/local/bin/ldb ...
CMU Common Lisp 10-May-1991, running on liasun3
Hemlock 10-May-1991, Compiler 10-May-1991
Send bug reports and questions to Gripe.
* 
* (load "symbol-printer-test")
T
* (symbol-test)
FOO 
FOO 
A:FOO
B:FOO
* 
- ------------------------------------------------------------------------------
Starting /usr/local/bin/cl ...
Allegro CL 4.0.1 [Sun4] (2/8/91)
Copyright (C) 1985-1991, Franz Inc., Berkeley, CA, USA
; Loading /users/simon/cl/custom.cl.
; Loading /users/simon/cl/all.lisp.
; Loading /users/simon/cl/aspic/defsys.lisp.
; Fast loading /users/simon/cl/aspic/source-info/simple-source.fasl.
<cl>  
<cl> (load "symbol-printer-test")
; Loading /export/laika/ftp/pub/lisp/cmucl/symbol-printer-test.lisp.

T 
<cl> (symbol-test)
A:FOO 
FOO 
A:FOO 
B:FOO 
<cl> 
- ------------------------------------------------------------------------------
POSSIBLE FIX:

In file code/print.lisp, replace the definition of OUTPUT-SYMBOL by
the following one:

(defun output-symbol (object stream)
  (let ((package (symbol-package object))
	(name (symbol-name object)))
    (cond
     ;; If the symbol's home package is the current one, then a
     ;; prefix is never necessary.
     ((eq package *package*))
     ;; If the symbol is in the keyword package, output a colon.
     ((eq package *keyword-package*)
      (write-char #\: stream))
     ;; Uninterned symbols print with a leading #:.
     ((null package)
      (when *print-gensym* (write-string "#:" stream)))
     (t
      (multiple-value-bind (symbol accessible)
	  (find-symbol name *package*)
	;; If we can find the symbol by looking it up, it need not be
	;; qualified.  This can happen if the symbol has been inherited
	;; from a package other than its home package.
	(unless (and accessible (eq symbol object))
	  (funcall *internal-symbol-output-function*
		   (package-name package)
		   stream)
	  (multiple-value-bind (symbol externalp)
	      (find-external-symbol name package)
	    (declare (ignore symbol))
	    (if externalp
		(write-char #\: stream)
		(write-string "::" stream)))))))
    (funcall *internal-symbol-output-function* name stream)))

------- End of Forwarded Message