[cxml-cvs] CVS update: cxml/xml/xml-parse.lisp

[David Lichteblau]

Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv16400/xml

Modified Files:
	xml-parse.lisp 
Log Message:
ignore-errors workaround fuer PATHNAME auf SBCL
Date: Sat Nov 26 23:21:51 2005
Author: dlichteblau

Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.8 cxml/xml/xml-parse.lisp:1.9
--- cxml/xml/xml-parse.lisp:1.8	Sat Nov 26 23:15:10 2005
+++ cxml/xml/xml-parse.lisp	Sat Nov 26 23:21:51 2005
@@ -2950,7 +2950,9 @@
 
 (defun safe-stream-sysid (stream)
   (if (and (typep (resolve-synonym-stream stream) 'file-stream)
-           (pathname stream))
+	   ;; ignore-errors, because sb-bsd-sockets creates instances of
+	   ;; FILE-STREAMs that aren't
+           (ignore-errors (pathname stream)))
       (pathname-to-uri (pathname stream))
       nil))
 
@@ -3063,113 +3065,6 @@
        '(consume-token zstream)) )
    name kind))
 
-;;;;
-
-#|
-
-(defparameter *test-files*
-    '(;;"jclark:xmltest;not-wf;*;*.xml"
-      "jclark:xmltest;valid;*;*.xml"
-      ;;"jclark:xmltest;invalid;*.xml"
-      ))
-
-(defun run-all-tests (&optional (test-files *test-files*))
-  (let ((failed nil))
-    (dolist (k test-files)
-      (dolist (j (sort (directory k) #'string< :key #'pathname-name))
-        (unless (test-file j)
-          (push j failed))))
-    (fresh-line)
-    (cond (failed
-           (write-string "**** Test failed on")
-           (dolist (k failed)
-             (format t "~%****  ~S." k))
-           nil)
-          (t
-           (write-string "**** Test passed!")
-           t))))
-
-(defun test-file (filename)
-  (let ((out-filename (merge-pathnames "out/" filename)))
-    (if (probe-file out-filename)
-        (positive-test-file filename out-filename)
-      (negative-test-file filename))))
-
-(defun positive-test-file (filename out-filename)
-  (multiple-value-bind (nodes condition)
-      (ignore-errors (parse-file filename))
-    (cond (condition
-           (warn "**** Error in ~S: ~A." filename condition)
-           nil)
-          (t
-           (let (res equal?)
-             (setf res (with-output-to-string (sink)
-                         (unparse-document nodes sink)))
-             (setf equal?
-               (with-open-file (in out-filename :direction :input :element-type 'character)
-                 (do ((i 0 (+ i 1))
-                      (c (read-char in nil nil) (read-char in nil nil)))
-                     ((or (eq c nil) (= i (length res)))
-                      (and (eq c nil) (= i (length res))))
-                   (unless (eql c (char res i))
-                     (return nil)))))
-             (cond ((not equal?)
-                    (format t "~&**** Test failed on ~S." filename)
-                    (fresh-line)
-                    (format t "** me: ~A" res)
-                    (fresh-line)
-                    (format t "** he: " res)
-                    (finish-output)
-                    (with-open-file (in out-filename :direction :input :element-type 'character)
-                      (do ((c (read-char in nil nil) (read-char in nil nil)))
-                          ((eq c nil))
-                        (write-char c)))
-                    nil)
-                   (t
-                    t)))))))
-
-(defun negative-test-file (filename)
-  (multiple-value-bind (nodes condition)
-      (ignore-errors (parse-file filename))
-    (declare (ignore nodes))
-    (cond (condition
-           t)
-          (t
-           (warn "**** negative test failed on ~S." filename)))))
-
-|#
-
-;;;;
-
-#+(or)                                  ;was ist das?
-(progn
-
-  (defmethod dom:create-processing-instruction ((document null) target data)
-    (declare (ignorable document target data))
-    nil)
-
-  (defmethod dom:append-child ((node null) child)
-    (declare (ignorable node child))
-    nil)
-
-  (defmethod dom:create-element ((document null) name)
-    (declare (ignorable document name))
-    nil)
-
-  (defmethod dom:set-attribute ((document null) name value)
-    (declare (ignorable document name value))
-    nil)
-
-  (defmethod dom:create-text-node ((document null) data)
-    (declare (ignorable document data))
-    nil)
-
-  (defmethod dom:create-cdata-section ((document null) data)
-    (declare (ignorable document data))
-    nil)
-  )
-
-
 #||
 (defmacro read-data-until* ((predicate input res res-start res-end) &body body)
   ;; fast variant -- for now disabled for no apparent reason
@@ -3223,9 +3118,6 @@
              (sf rptr (%+ rptr 1))) ))
     , at body ))
 ||#
-
-;(defun read-data-until (predicate input continuation)
-;  )
 
 (defmacro read-data-until* ((predicate input res res-start res-end) &body body)
   "Read data from `input' until `predicate' applied to the read char