file-test.ss
;;;
;;; Time-stamp: <06/02/05 20:42:28 noel>
;;;
;;; Copyright (C) 2005 by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:
(module file-test mzscheme
  
  (require 
   (lib "file.ss")
   (planet "test.ss" ("schematics" "schemeunit.plt" 2))
   (file "file.ss")
   )
  
  (provide file-tests)
  
  ; Test data for make-non-conflicting-filename:
  (define dir (build-path "make-non-conflicting-filename-test"))
  (define file1 "file-with-extension.ext")
  (define file2 "file-with-extension1.ext")
  (define file3 "file-with-extension2.ext")
  (define file4 "file-without-extension")
  (define file5 "file-without-extension1")
  (define file6 "file-without-extension2")
  (define file7 "file-with-two.extensions.ext")
  
  ;; touch : path -> void
  ;;
  ;; Used in tests for make-non-conflicting-filename
  (define (touch path)
    (if (not (file-exists? path))
        (with-output-to-file path
          (lambda ()
            (display "I'm a temporary file: feel free to delete me.")))))
  
  (define file-tests
    (test-suite
     "file.ss"
     
     (test-case
      "make-directory-tree creates single directory"
      (check-false (directory-exists? "testing"))
      (make-directory-tree "testing")
      (check-true (directory-exists? "testing"))
      (delete-directory "testing"))

     (test-case
      "make-directory-tree creates list of directories"
      (let ((dirs '("t1" "t2" "t3")))
        (map (lambda (dir)
               (check-false (directory-exists? dir)))
             dirs)
        (make-directory-tree dirs)
        (map (lambda (dir)
               (check-true (directory-exists? dir)))
             dirs)
        (map delete-directory dirs)))

     (test-case
      "make-directory-tree creates tree of directories"
      (check-false (directory-exists? "a"))
      (check-false (directory-exists? "a/b"))
      (check-false (directory-exists? "a/c"))
      (check-false (directory-exists? "a/c/d"))
      (make-directory-tree '("a" ("b" "c" ("d"))))
      (check-true (directory-exists? "a"))
      (check-true (directory-exists? "a/b"))
      (check-true (directory-exists? "a/c"))
      (check-true (directory-exists? "a/c/d"))
      (delete-directory "a/c/d")
      (delete-directory "a/c")
      (delete-directory "a/b")
      (delete-directory "a"))
     
     (test-not-exn
      "Dummy test: creates files for make-non-conflicting-filename tests"
      (lambda ()
        (unless (directory-exists? dir)
          (make-directory dir))
        (touch (build-path dir file1))
        (touch (build-path dir file2))
        (touch (build-path dir file3))
        (touch (build-path dir file4))
        (touch (build-path dir file5))
        (touch (build-path dir file6))
        (touch (build-path dir file7))))

     (test-equal?
      "make-non-conflicting-filename works when there are no conflicts"
      (make-non-conflicting-filename dir "non-conflicting-filename.ext")
      "non-conflicting-filename.ext")
     
     (test-equal?
      "make-non-conflicting-filename works for files with extensions"
      (make-non-conflicting-filename dir file1)
      "file-with-extension3.ext")
           
     (test-equal?
      "make-non-conflicting-filename works for files with no extensions"
      (make-non-conflicting-filename dir file4)
      "file-without-extension3")
           
     (test-equal?
      "make-non-conflicting-filename works for files with two extensions"
      (make-non-conflicting-filename dir file7)
      "file-with-two.extensions1.ext")
     
     (test-equal?
      "make-non-conflicting-filename works when a filename with an index is supplied"
      (make-non-conflicting-filename dir file2)
      "file-with-extension3.ext")

     (test-equal?
      "make-non-conflicting-path works as expected"
      (make-non-conflicting-path dir file1)
      (build-path dir "file-with-extension3.ext"))

     (test-not-exn
      "Dummy test: deletes files from make-non-conflicting-filename tests"
      (lambda ()
        (delete-directory/files dir)))

     ))
  )