;;;
;;; Time-stamp: <06/03/11 12:44:57 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 <[email protected]>
;;
;;
;; Commentary:

;; This script converts tests from SchemeUnit 2.0 to 3.0
;;
;; It performs the following modifications:
;;  -  changes Planet require statement
;;  -  changes make-test-suite to test-suite
;;  -  changes make-test-case to test-case

;; To use, call convert with the base directory.  It will
;; update all files under in directory tree rooted at that
;; directory that appear to be SchemeUnit files. E.g.:
;;
;;   (convert "my/directory")
;;
;; Note that backups are always made in case of error.

(module convert mzscheme

  (require (planet "port.ss" ("schematics" "port.plt" 1))
           (planet "file.ss" ("dherman" "io.plt" 1))
           (planet "loud.ss" ("ryanc" "scripting.plt" 1)))

  (provide convert
           convert-file)
  
  (define schemeunit-require-regexp
    #rx"\"schematics\" \"schemeunit.plt\" 1( [0-9])?")

  ;; in-svn-dir? : path -> (U #t #f)
  (define (in-svn-dir? path)
    (regexp-match #rx".svn" (path->string path)))

  ;; file-contains? : regexp path -> (U #t #f)
  ;;
  ;; True if file contains a string matching regexp
  (define (file-contains? path regexp)
    (if (regexp-match regexp (port->string (open-input-file path)))
        #t
        #f))

  ;; test-file : path -> (U #t #f)
  ;;
  ;; True if the file looks like it contains SchemeUnit tests.
  ;; Determines this by checking for presence of
  ;; schemeunit-require-regexp
  (define (test-file? file)
    (file-contains? file schemeunit-require-regexp))

  ;; backup-file : path -> void
  ;;
  ;; Create a backup copy of a file -- the backup has the name
  ;; of the original file with .backup appended to it.
  (define (backup-file file)
    (loud:copy-file file
                    (string-append (path->string file) ".backup")))

  ;; conver-file : path -> void
  ;;
  ;; Convert a file to SchemeUnit 3.0
  (define (convert-file file)
    (let* ((str1 (port->string (open-input-file file)))
           (str2 (regexp-replace*
                  schemeunit-require-regexp
                  str1
                  "\"schematics\" \"schemeunit.plt\" 2"))
           (str3 (regexp-replace*
                  #rx"make-test-case"
                  str2
                  "test-case"))
           (str4 (regexp-replace*
                  #rx"make-test-suite"
                  str3
                  "test-suite"))
           (str5 (regexp-replace*
                  #rx"assertion"
                  str4
                  "check"))
           (str6 (regexp-replace*
                  #rx"assert"
                  str5
                  "check")))
      (with-output-to-file file
        (lambda () (display str6))
        'replace)))

  ;; convert : path -> void
  ;;
  ;; Convert all files rooted at base-dir that look like
  ;; SchemeUnit files
  (define (convert base-dir)
    (let ((files (directory-list/all base-dir)))
      (for-each
       (lambda (file-or-dir)
         (let ((full-path (build-path base-dir file-or-dir)))
           (when (and (file-exists? full-path)
                      (not (in-svn-dir? full-path))
                      (test-file? full-path))
             (printf "Updating file ~a.\n" full-path)
             (backup-file full-path)
             (convert-file full-path)
             (printf "Done.\n"))))
       files)))

  )