CVS: sbcl/src/code .cvsignore,NONE,1.1 filesys.lisp,1.34,1.35 late-format.lisp,1.11,1.12 target-format.lisp,1.12,1.13 target-pathname.lisp,1.27,1.28

Update of /cvsroot/sbcl/sbcl/src/code
In directory usw-pr-cvs1:/tmp/cvs-serv12298/src/code

Modified Files:
        filesys.lisp late-format.lisp target-format.lisp 
        target-pathname.lisp 
Added Files:
        .cvsignore 
Log Message:
0.7.3.13:
        Fix bug 22, throwing an error for bad directives inside ~< ~:> 
        format blocks.
        Bugfix for host-namestring (and associated host-using functions):
        ... make the physical host name be "" (not "Unix), as this cannot 
                be a logical host name
        ... some sanity checking in logical host functionality regarding
                this change
        Remove fixed buglets from BUGS
        Added .cvsignore files for files built in warm init.


--- NEW FILE: .cvsignore ---
describe.fasl
force-delayed-defbangmethods.fasl
foreign.fasl
inspect.fasl
ntrace.fasl
profile.fasl
run-program.fasl

Index: filesys.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/filesys.lisp,v
retrieving revision 1.34
retrieving revision 1.35
diff -C2 -d -r1.34 -r1.35
*** filesys.lisp        18 Apr 2002 21:58:56 -0000      1.34
--- filesys.lisp        10 May 2002 10:48:34 -0000      1.35
***************
*** 273,277 ****
    (declare (type pathname pathname)
           (ignore pathname))
!   "Unix")
  
  (defun unparse-unix-piece (thing)
--- 273,281 ----
    (declare (type pathname pathname)
           (ignore pathname))
!   ;; 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)

Index: late-format.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-format.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** late-format.lisp    12 Mar 2002 15:47:54 -0000      1.11
--- late-format.lisp    10 May 2002 10:48:34 -0000      1.12
***************
*** 949,952 ****
--- 949,969 ----
  ;;;; 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)
***************
*** 959,964 ****
           (expand-format-logical-block prefix per-line-p insides
                                        suffix atsignp))
!        (expand-format-justification segments colonp atsignp
!                                     first-semi params))
       remaining)))
  
--- 976,988 ----
           (expand-format-logical-block prefix per-line-p insides
                                        suffix atsignp))
!        (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)))
  

Index: target-format.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-format.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** target-format.lisp  9 Mar 2002 19:10:39 -0000       1.12
--- target-format.lisp  10 May 2002 10:48:34 -0000      1.13
***************
*** 1068,1074 ****
                                                prefix per-line-p insides
                                                suffix atsignp))
!             (interpret-format-justification stream orig-args args
!                                             segments colonp atsignp
!                                             first-semi params)))
      remaining))
  
--- 1068,1081 ----
                                                prefix per-line-p insides
                                                suffix atsignp))
!             (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))
  

Index: target-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-pathname.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -d -r1.27 -r1.28
*** target-pathname.lisp        18 Apr 2002 21:58:57 -0000      1.27
--- target-pathname.lisp        10 May 2002 10:48:34 -0000      1.28
***************
*** 500,503 ****
--- 500,504 ----
         (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
***************
*** 759,762 ****
--- 760,769 ----
    ;; 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
***************
*** 1141,1144 ****
--- 1148,1157 ----
  (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))


_______________________________________________________________

Have big pipes? SourceForge.net is looking for download mirrors. We supply
the hardware. You get the recognition. Email Us: bandwidth@xxxxxxxxxxxxxxx