diff options
Diffstat (limited to 'test-suite/tests/load.test')
-rw-r--r-- | test-suite/tests/load.test | 126 |
1 files changed, 0 insertions, 126 deletions
diff --git a/test-suite/tests/load.test b/test-suite/tests/load.test deleted file mode 100644 index 6b0de7612..000000000 --- a/test-suite/tests/load.test +++ /dev/null @@ -1,126 +0,0 @@ -;;;; load.test --- test LOAD and path searching functions -*- scheme -*- -;;;; Jim Blandy <jimb@red-bean.com> --- September 1999 -;;;; -;;;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. -;;;; -;;;; This program 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 2, or (at your option) -;;;; any later version. -;;;; -;;;; This program 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 this software; see the file COPYING. If not, write to -;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, -;;;; Boston, MA 02111-1307 USA - -(use-modules (test-suite lib)) - -(define temp-dir (data-file-name "load-test.dir")) - -(define (create-tree parent tree) - (let loop ((parent parent) - (tree tree)) - (if (pair? tree) - (let ((elt (car tree))) - (cond - - ;; A string means to create an empty file with that name. - ((string? elt) - (close-port (open-file (string-append parent "/" elt) "w"))) - - ;; A list means to create a directory, and then create files - ;; within it. - ((pair? elt) - (let ((dirname (string-append parent "/" (car elt)))) - (mkdir dirname) - (loop dirname (cdr elt)))) - - (else - (error "create-tree: bad tree structure"))) - - (loop parent (cdr tree)))))) - -(define (delete-tree tree) - (cond - ((file-is-directory? tree) - (let ((dir (opendir tree))) - (let loop () - (let ((entry (readdir dir))) - (cond - ((member entry '("." "..")) - (loop)) - ((not (eof-object? entry)) - (let ((name (string-append tree "/" entry))) - (delete-tree name) - (loop)))))) - (closedir dir) - (rmdir tree))) - ((file-exists? tree) - (delete-file tree)) - (else - (error "delete-tree: can't delete " tree)))) - -(define (try-search-with-extensions path input extensions expected) - (let ((test-name (call-with-output-string - (lambda (port) - (display "search-path for " port) - (write input port) - (if (pair? extensions) - (begin - (display " with extensions " port) - (write extensions port))) - (display " yields " port) - (write expected port))))) - (let ((result (search-path path input extensions))) - (pass-if test-name - (equal? (if (string? expected) - (string-append temp-dir "/" expected) - expected) - result))))) - -(define (try-search path input expected) - (try-search-with-extensions path input '() expected)) - -;; Create a bunch of files for use in testing. -(mkdir temp-dir) -(create-tree temp-dir - '(("dir1" "foo.scm" "bar.scm" "ugly.scm.scm" - ("subdir1")) - ("dir2" "foo.scm" "baz.scm" "baz.ss" "ugly.scm.ss") - ("dir3" "ugly.scm" "ugly.ss.scm"))) - -;; Try some searches without extensions. -(define path (list - (string-append temp-dir "/dir1") - (string-append temp-dir "/dir2") - (string-append temp-dir "/dir3"))) - -(try-search path "foo.scm" "dir1/foo.scm") -(try-search path "bar.scm" "dir1/bar.scm") -(try-search path "baz.scm" "dir2/baz.scm") -(try-search path "baz.ss" "dir2/baz.ss") -(try-search path "ugly.scm" "dir3/ugly.scm") -(try-search path "subdir1" #f) - -(define extensions '(".ss" ".scm" "")) -(try-search-with-extensions path "foo" extensions "dir1/foo.scm") -(try-search-with-extensions path "bar" extensions "dir1/bar.scm") -(try-search-with-extensions path "baz" extensions "dir2/baz.ss") -(try-search-with-extensions path "ugly.scm" extensions "dir3/ugly.scm") -(try-search-with-extensions path "ugly.ss" extensions #f) - -(if (defined? '%nil) - ;; Check that search-path accepts Elisp nil-terminated lists for - ;; PATH and EXTENSIONS. - (with-test-prefix "elisp-nil" - (set-cdr! (last-pair path) %nil) - (set-cdr! (last-pair extensions) %nil) - (try-search-with-extensions path "ugly.scm" extensions "dir3/ugly.scm") - (try-search-with-extensions path "ugly.ss" extensions #f))) - -(delete-tree temp-dir) |