DTC's recommended workaround from the mailing list 3 Mar 2000:
(setf (pcl::find-class 'ccc1) (pcl::find-class 'ccc))
-22:
- The ANSI spec, in section "22.3.5.2 Tilde Less-Than-Sign: Logical Block",
- says that an error is signalled if ~W, ~_, ~<...~:>, ~I, or ~:T is used
- inside "~<..~>" (without the colon modifier on the closing syntax).
- However, SBCL doesn't do this:
- * (FORMAT T "~<munge~wegnum~>" 12)
- munge12egnum
- NIL
-
27:
Sometimes (SB-EXT:QUIT) fails with
Argh! maximum interrupt nesting depth (4096) exceeded, exiting
MERGE also have the same problem.
c: (COERCE 'AND 'FUNCTION) returns something related to
(MACRO-FUNCTION 'AND), but ANSI says it should raise an error.
- f: (FLOAT-RADIX 2/3) should signal an error instead of
- returning 2.
g: (LOAD "*.lsp") should signal FILE-ERROR.
h: (MAKE-CONCATENATED-STREAM (MAKE-STRING-OUTPUT-STREAM))
should signal TYPE-ERROR.
TYPE-ERROR when handed e.g. the results of
MAKE-STRING-INPUT-STREAM or MAKE-STRING-OUTPUT-STREAM in
the inappropriate positions, but doesn't.
- j: (PARSE-NAMESTRING (COERCE (LIST #\f #\o #\o (CODE-CHAR 0) #\4 #\8)
- (QUOTE STRING)))
- should probably signal an error instead of making a pathname with
- a null byte in it.
k: READ-BYTE is supposed to signal TYPE-ERROR when its argument is
not a binary input stream, but instead cheerfully reads from
character streams, e.g. (MAKE-STRING-INPUT-STREAM "abc").
but SBCL doesn't do this. (Also as reported by AL in the same
message, SBCL depended on this nonconforming behavior to build
itself, because of the way that **CURRENT-SEGMENT** was implemented.
- As of sbcl-0.6.12.x, this dependence on the nonconforming behavior
+ As of sbcl-0.7.3.x, this dependence on the nonconforming behavior
has been fixed, but the nonconforming behavior remains.)
104:
isn't too surprising since there are many differences in stack
implementation and GC conservatism between the X86 and other ports.)
-163:
- HOST-NAMESTRING on a Unix pathname returns "Unix", which isn't
- treated as a valid host by anything else in the system. (Reported by
- Erik Naggum on comp.lang.lisp 2002-04-18)
-
164:
The type system still can't quite deal with all useful identities;
for instance, as of sbcl-0.7.2.18, the type specifier '(and (real -1
* The fasl file format has changed again, because dynamic loading
on OpenBSD (which has non-ELF object files) motivated some cleanups
in the way that foreign symbols are transformed and passed around.
+ * HOST-NAMESTRING on physical pathnames now returns a string that is
+ valid as a host argument to MERGE-PATHNAMES and to MAKE-PATHNAME.
planned incompatible changes in 0.7.x:
* When the profiling interface settles down, maybe in 0.7.x, maybe
--- /dev/null
+alloc.fasl
+arith.fasl
+array.fasl
+assem-rtns.fasl
--- /dev/null
+alloc.fasl
+arith.fasl
+array.fasl
+assem-rtns.fasl
--- /dev/null
+alloc.fasl
+arith.fasl
+array.fasl
+assem-rtns.fasl
--- /dev/null
+alloc.fasl
+arith.fasl
+array.fasl
+assem-rtns.fasl
--- /dev/null
+describe.fasl
+force-delayed-defbangmethods.fasl
+foreign.fasl
+inspect.fasl
+ntrace.fasl
+profile.fasl
+run-program.fasl
(defun unparse-unix-host (pathname)
(declare (type pathname pathname)
(ignore pathname))
- "Unix")
+ ;; this host designator needs to be recognized as a physical host in
+ ;; PARSE-NAMESTRING. Until sbcl-0.7.3.x, we had "Unix" here, but
+ ;; that's a valid Logical Hostname, so that's a bad choice. -- CSR,
+ ;; 2002-05-09
+ "")
(defun unparse-unix-piece (thing)
(etypecase thing
\f
;;;; format directives and support functions for justification
+(defparameter *illegal-inside-justification*
+ (mapcar (lambda (x) (parse-directive x 0))
+ '("~W" "~:W" "~@W" "~:@W"
+ "~_" "~:_" "~@_" "~:@_"
+ "~:>" "~:@>"
+ "~I" "~:I" "~@I" "~:@I"
+ "~:T" "~:@T")))
+
+(defun illegal-inside-justification-p (directive)
+ (member directive *illegal-inside-justification*
+ :test (lambda (x y)
+ (and (format-directive-p x)
+ (format-directive-p y)
+ (eql (format-directive-character x) (format-directive-character y))
+ (eql (format-directive-colonp x) (format-directive-colonp y))
+ (eql (format-directive-atsignp x) (format-directive-atsignp y))))))
+
(def-complex-format-directive #\< (colonp atsignp params string end directives)
(multiple-value-bind (segments first-semi close remaining)
(parse-format-justification directives)
close params string end)
(expand-format-logical-block prefix per-line-p insides
suffix atsignp))
- (expand-format-justification segments colonp atsignp
- first-semi params))
+ (let ((count (apply #'+ (mapcar (lambda (x) (count-if #'illegal-inside-justification-p x)) segments))))
+ (when (> count 0)
+ ;; ANSI specifies that "an error is signalled" in this
+ ;; situation.
+ (error 'format-error
+ :complaint "~D illegal directive~:P found inside justification block"
+ :args (list count)))
+ (expand-format-justification segments colonp atsignp
+ first-semi params)))
remaining)))
(def-complex-format-directive #\> ()
(interpret-format-logical-block stream orig-args args
prefix per-line-p insides
suffix atsignp))
- (interpret-format-justification stream orig-args args
- segments colonp atsignp
- first-semi params)))
+ (let ((count (apply #'+ (mapcar (lambda (x) (count-if #'illegal-inside-justification-p x)) segments))))
+ (when (> count 0)
+ ;; ANSI specifies that "an error is signalled" in this
+ ;; situation.
+ (error 'format-error
+ :complaint "~D illegal directive~:P found inside justification block"
+ :args (list count)))
+ (interpret-format-justification stream orig-args args
+ segments colonp atsignp
+ first-semi params))))
remaining))
(defun interpret-format-justification
;; It seems an error message is appropriate.
(host (typecase host
(host host) ; A valid host, use it.
+ ((string 0) *unix-host*) ; "" cannot be a logical host
(string (find-logical-host host t)) ; logical-host or lose.
(t default-host))) ; unix-host
(diddle-args (and (eq (host-customary-case host) :lower)
;; A logical host is an object of implementation-dependent nature. In
;; SBCL, it's a member of the HOST class (a subclass of STRUCTURE-OBJECT).
(let ((found-host (etypecase host
+ ((string 0)
+ ;; This is a special host. It's not valid as a
+ ;; logical host, so it is a sensible thing to
+ ;; designate the physical Unix host object. So
+ ;; we do that.
+ *unix-host*)
(string
;; In general ANSI-compliant Common Lisps, a
;; string might also be a physical pathname host,
;;; contains only legal characters.
(defun logical-word-or-lose (word)
(declare (string word))
+ (when (string= word "")
+ (error 'namestring-parse-error
+ :complaint "Attempted to treat invalid logical hostname ~
+ as a logical host:~% ~S"
+ :args (list word)
+ :namestring word :offset 0))
(let ((word (string-upcase word)))
(dotimes (i (length word))
(let ((ch (schar word i)))
--- /dev/null
+boot.fasl
+braid.fasl
+cache.fasl
+combin.fasl
+compiler-support.fasl
+cpl.fasl
+ctypes.fasl
+defclass.fasl
+defcombin.fasl
+defs.fasl
+describe.fasl
+dfun.fasl
+dlisp2.fasl
+dlisp3.fasl
+dlisp.fasl
+documentation.fasl
+early-low.fasl
+env.fasl
+fast-init.fasl
+fixup.fasl
+fngen.fasl
+fsc.fasl
+generic-functions.fasl
+gray-streams-class.fasl
+gray-streams.fasl
+init.fasl
+low.fasl
+macros.fasl
+methods.fasl
+precom1.fasl
+precom2.fasl
+print-object.fasl
+slots-boot.fasl
+slots.fasl
+std-class.fasl
+vector.fasl
+walk.fasl
;;;; or failure in these tests doesn't tell you anything about
;;;; ANSI-compliance unless your PARSE-NAMESTRING works like ours.
-(setf (logical-pathname-translations "scratch")
- '(("**;*.*.*" "/usr/local/doc/**/*")))
+;;; Needs to be done at compile time, so that the #p"" read-macro
+;;; correctly parses things as logical pathnames. This is not a
+;;; problem as was, as this is an impure file and so gets loaded in,
+;;; but just for future proofing...
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (logical-pathname-translations "scratch")
+ '(("**;*.*.*" "/usr/local/doc/**/*"))))
(loop for (expected-result . params) in
`(;; trivial merge
;; as a name)
(#p"/dir/name.supplied-type"
,(make-pathname :type "supplied-type")
- #p"/dir/name.type")
+ #p"/dir/name.type")
;; If (pathname-directory pathname) is a list whose car is
;; :relative, and (pathname-directory default-pathname) is a
;; list, then the merged directory is [...]
(#P"/aaa/bbb/ccc/blah/eee"
;; "../" in a namestring is parsed as :up not :back, so make-pathname
,(make-pathname :directory '(:relative :back "blah"))
- #p"/aaa/bbb/ccc/ddd/eee")
+ #p"/aaa/bbb/ccc/ddd/eee")
;; If (pathname-directory default-pathname) is not a list or
;; (pathname-directory pathname) is not a list whose car is
;; :relative, the merged directory is (or (pathname-directory
;; pathname) (pathname-directory default-pathname))
(#P"/absolute/path/name.type"
#p"/absolute/path/name"
- #p"/dir/default-name.type")
+ #p"/dir/default-name.type")
;; === logical pathnames ===
;; recognizes a logical pathname namestring when
;; default-pathname is a logical pathname
- ;; FIXME: 0.6.12.23 fails this one.
+ ;; FIXME: 0.6.12.23 fails this one.
+ ;;
+ ;; And, as it happens, it's right to fail it. Because
+ ;; #p"name1" is read in with the ambient *d-p-d* value, which
+ ;; has a physical (Unix) host; therefore, the host of the
+ ;; default-pathname argument to merge-pathnames is
+ ;; irrelevant. The result is (correctly) different if
+ ;; '#p"name1"' is replaced by "name1", below, though it's
+ ;; still not what one might expect... -- CSR, 2002-05-09
#+nil (#P"scratch:foo;name1" #p"name1" #p"scratch:foo;")
;; or when the namestring begins with the name of a defined
;; logical host followed by a colon [I assume that refers to pathname
do (assert (string= (namestring (apply #'merge-pathnames params))
(namestring expected-result))))
\f
+;;; host-namestring testing
+(assert (string=
+ (namestring (parse-namestring "/foo" (host-namestring #p"/bar")))
+ "/foo"))
+(assert (string=
+ (namestring (parse-namestring "FOO" (host-namestring #p"SCRATCH:BAR")))
+ "SCRATCH:FOO"))
+(assert (raises-error?
+ (setf (logical-pathname-translations "")
+ (list '("**;*.*.*" "/**/*.*")))))
+\f
;;;; success
(quit :unix-status 104)
(assert (string= (format nil "~/cl-user:print-foo:print-foo/" 2) "2"))
(assert (string= (format nil "~/cl-user::print-foo:print-foo/" 2) "2"))
+;;; Check for error detection of illegal directives in a~<..~> justify
+;;; block (see ANSI section 22.3.5.2)
+(assert (raises-error? (format nil "~<~W~>" 'foo)))
+(assert (raises-error? (format nil "~<~<~A~:>~>" '(foo))))
+(assert (string= (format nil "~<~<~A~>~>" 'foo) "FOO"))
+
;;; success
(quit :unix-status 104)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.3.12"
+"0.7.3.13"
projects / sbcl.git / commitdiff