load.scm

;;; ----------------------------------------------------------------------
;;; Copyright 2007-2008 Alexey Radul.
;;; ----------------------------------------------------------------------
;;; This file is part of Test Manager.
;;; 
;;; Test Manager is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;; 
;;; Test Manager 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 General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with Test Manager.  If not, see <http://www.gnu.org/licenses/>.
;;; ----------------------------------------------------------------------

;; load-relative, broken in Guile, depends on MIT Scheme's pathname
;; system.
;; TODO Fix for interactive use?
(cond-expand
 (guile
  (if (defined? 'load-relative)
      'ok
      (define (load-relative filename)
	;; Guile's load appears to magically do the right thing...
	(load (string-concatenate (list filename ".scm"))))))
 (else ;; The MIT Scheme that knows it is 'mit' isn't in Debian Stable yet
  (define (load-relative filename #!optional environment)
    (let ((place (ignore-errors current-load-pathname)))
      (if (pathname? place)
          (with-working-directory-pathname
           (directory-namestring (current-load-pathname))
           (lambda () (load filename environment)))
          (load filename environment))))))

(load-relative "portability")
(load-relative "ordered-map")
(load-relative "matching")
(load-relative "assertions")
(load-relative "test-runner")
(load-relative "test-group")
(load-relative "testing")
(load-relative "checks")
(load-relative "interactions")

;; MIT Scheme specific features
(cond-expand
 (guile
  'ok)
 (else
  'ok))