;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Aug 14 13:59:18 2004
;;;; Contains: Tests of PARSE-NAMESTRING



;;; "Parsing a null string always succeeds, producing a pathname
;;;  with all components (except the host) equal to nil."

(deftest parse-namestring.1
  (let ((vals (multiple-value-list (parse-namestring ""))))
    (assert (= (length vals) 2))
    (let ((pn (first vals))
          (pos (second vals)))
      (values
       (pathname-directory pn)
       (pathname-device pn)
       (pathname-name pn)
       (pathname-type pn)
       (pathname-version pn)
       pos)))
  nil nil nil nil nil 0)

(deftest parse-namestring.2
  (let ((vals (multiple-value-list (parse-namestring (make-array 0 :element-type 'base-char)))))
    (assert (= (length vals) 2))
    (let ((pn (first vals))
          (pos (second vals)))
      (values
       (pathname-directory pn)
       (pathname-device pn)
       (pathname-name pn)
       (pathname-type pn)
       (pathname-version pn)
       pos)))
  nil nil nil nil nil 0)

(deftest parse-namestring.3
  (let ((vals (multiple-value-list (parse-namestring (make-array 4 :element-type 'base-char
                                                                 :initial-element #\X
                                                                 :fill-pointer 0)))))
    (assert (= (length vals) 2))
    (let ((pn (first vals))
          (pos (second vals)))
      (values
       (pathname-directory pn)
       (pathname-device pn)
       (pathname-name pn)
       (pathname-type pn)
       (pathname-version pn)
       pos)))
  nil nil nil nil nil 0)

(deftest parse-namestring.4
  (loop for etype in '(standard-char base-char character)
        for s0 = (make-array 4 :element-type etype :initial-element #\X)
        for s = (make-array 0 :element-type etype :displaced-to s0
                            :displaced-index-offset 1)
        for vals = (multiple-value-list (parse-namestring s))
        for pn = (first vals)
        for pos = (second vals)
        do (assert (= (length vals) 2))
        nconc
        (let ((result (list (pathname-directory pn)
                            (pathname-device pn)
                            (pathname-name pn)
                            (pathname-type pn)
                            (pathname-version pn)
                            pos)))
          (unless (equal result '(nil nil nil nil nil 0))
            (list (list etype result)))))
  nil)

(deftest parse-namestring.5
  (let* ((pathname (parse-namestring "cltest:temp.dat.newest"))
         (namestring (namestring pathname)))
    (and (typep pathname 'logical-pathname)
         (or (equal namestring "CLTEST:TEMP.DAT.NEWEST")
             (equal namestring "CLTEST:TEMP.DAT.newest"))))
  t)

;;; Error tests

(deftest parse-namestring.error.1
  (signals-error (parse-namestring) program-error)
  t)

(deftest parse-name-string.error.2
  (signals-error (parse-namestring "" nil *default-pathname-defaults* :foo nil) program-error)
  t)

(deftest parse-name-string.error.3
  (signals-error (parse-namestring "" nil *default-pathname-defaults* :start) program-error)
  t)