(defstruct (uri (:constructor %make-uri))
  scheme
  userinfo
  host
  port
  path
  query
  fragment)

 Did 448 checks.
    Pass: 446 (99%)
    Skip: 0 ( 0%)
    Fail: 2 ( 0%)

 Failure Details:
 --------------------------------
 TEST-GET-SLAVE-USER in TEST-MASTER-SLAVE []: 
      Unexpected Error: #<USOCKET:ADDRESS-IN-USE-ERROR {1024902D33}>
Condition USOCKET:ADDRESS-IN-USE-ERROR was signalled..
 --------------------------------
 --------------------------------
 TEST-GET-MASTER-USER in TEST-MASTER-SLAVE []: 
      Unexpected Error: #<UNDEFINED-FUNCTION STOP-SERVER {1024767E73}>
The function S-SYSDEPS::STOP-SERVER is undefined..
 --------------------------------

;; The new _exported_ method, defaults to calling the original behaviour.
(defmethod serialize-sexp-slot ((object standard-object) slot-name stream serialization-state)
  (s-serialization::serialize-sexp-internal (slot-value object slot-name)
                                            stream serialization-state))

; Existing function, tweaked to use the new method.
(defmethod serialize-sexp-internal ((object standard-object) stream serialization-state)
  "Hack of `s-serialization::serialize-sexp-internal' to allow for extensible slot serialization."
  (let ((id (s-serialization::known-object-id serialization-state object)))
    (if id
	(progn
	  (write-string "(:REF . " stream)
	  (prin1 id stream)
	  (write-string ")" stream))
        (let ((serializable-slots (s-serialization::get-serializable-slots serialization-state object)))
	  (setf id (s-serialization::set-known-object serialization-state object))
	  (write-string "(:OBJECT " stream)
	  (prin1 id stream)
	  (write-string " :CLASS " stream)
	  (s-serialization::print-symbol (class-name (class-of object)) stream)
          (when serializable-slots
            (princ " :SLOTS (" stream)
            (loop :for slot :in serializable-slots
                  :do (when (slot-boundp object slot)
                        (write-string " (" stream)
                        (s-serialization::print-symbol slot stream)
                        (write-string " . " stream)
                        (serialize-sexp-slot object slot stream serialization-state)
                        (write-string ")" stream))))
	  (write-string " ) )" stream)))))


;; Example customization on the user's side:
(defmethod serialize-sexp-slot ((my-object my-object-class) (slot (eql 'foo-slot)) stream serialization-sexp-slot)
  (if slot ...))

Unknown :TEST for MAKE-HASH-TABLE: MY-TEST-FUNCTION

(export '*local*)
(defvar *local-package* nil
  "If `*local-package*' designates a package instance, don't print the package
  prefix of its symbols.")

(defun print-symbol (symbol stream)
  (let ((package (symbol-package symbol))
	(name (prin1-to-string symbol)))
    (cond ((eq package +cl-package+) (write-string "CL:" stream))
	  ((eq package +keyword-package+) (write-char #\: stream))
          ((eq package *local-package*)
           ;; Don't print the package prefix.
           nil)
	  (package (s-xml:print-string-xml (package-name package) stream)
                   (write-string "::" stream))
          (t (write-string "#:" stream)))
    (if (char= (char name (1- (length name))) #\|)
        (write-string name stream :start (position #\| name))
      (write-string name stream :start (1+ (or (position #\: name :from-end t) -1))))))

(defmethod serialize-sexp-internal ((object function) stream serialization-state)
  "Serialize function OBJECT.
If the function is named FOO, serialized is to \"#'FOO\".
Note: Function serialization is not part of the original cl-prevalence."
  (declare (ignore serialization-state))
  (let ((function-symbol (nth-value 2 (function-lambda-expression object))))
    (unless (symbolp function-symbol)
      (error "Cannot serialize anonymous functions (lambdas)"))
    (write-string "(:FUNCTION . " stream)
    (print-symbol function-symbol stream)
    (write-string ")" stream)))

(defmethod serialize-sexp-internal ((object pathname) stream serialization-state)
  "Serialize pathname OBJECT to it's printed representation starting with #P.
Note: Function serialization is not part of the original cl-prevalence."
  (declare (ignore serialization-state))
  (prin1 object stream))

(export '*one-element-per-line*)
(defvar *one-element-per-line* nil
  "If non-nil, print one element per line in sequence types.")

(defun maybe-newline (stream)
  (when *one-element-per-line*
    (write-char #\newline stream)))

(defmethod serialize-sexp-internal ((object sequence) stream serialization-state)
  "Like the original `serialize-sexp-internal' but uses `*one-element-per-line* to "
  (flet ((proper-sequence (length)
           (let ((id (set-known-object serialization-state object)))
             (write-string "(:SEQUENCE " stream)
             (prin1 id stream)
             (write-string " :CLASS " stream)
             (print-symbol (etypecase object (list 'list) (vector 'vector)) stream)
             (write-string " :SIZE " stream)
             (prin1 length stream)
             (unless (zerop length)
               (write-string " :ELEMENTS (" stream)
               (maybe-newline stream)
               (map nil
                    #'(lambda (element)
                        (write-string " " stream)
                        (serialize-sexp-internal element stream serialization-state)
                        (maybe-newline stream))
                    object))
             (write-string " ) )" stream)))
         (improper-list ()
           (let ((id (set-known-object serialization-state object)))
             (write-string "(:CONS " stream)
             (prin1 id stream)
             (write-char #\Space stream)
             (serialize-sexp-internal (car object) stream serialization-state)
             (write-char #\Space stream)
             (serialize-sexp-internal (cdr object) stream serialization-state)
             (write-string " ) " stream))))
    (let ((id (known-object-id serialization-state object)))
      (if id
          (progn
            (write-string "(:REF . " stream)
            (prin1 id stream)
            (write-string ")" stream))
          (multiple-value-bind (seq-type length) (sequence-type-and-length object)
            (ecase seq-type
              ((:proper-sequence :proper-list) (proper-sequence length))
              ((:dotted-list :circular-list) (improper-list))))))))