1;;;; load.test --- test LOAD and path searching functions -*- scheme -*- 2;;;; Jim Blandy <jimb@red-bean.com> --- September 1999 3;;;; 4;;;; Copyright (C) 1999, 2001, 2006, 2010, 2012 Free Software Foundation, Inc. 5;;;; 6;;;; This library is free software; you can redistribute it and/or 7;;;; modify it under the terms of the GNU Lesser General Public 8;;;; License as published by the Free Software Foundation; either 9;;;; version 3 of the License, or (at your option) any later version. 10;;;; 11;;;; This library is distributed in the hope that it will be useful, 12;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 13;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14;;;; Lesser General Public License for more details. 15;;;; 16;;;; You should have received a copy of the GNU Lesser General Public 17;;;; License along with this library; if not, write to the Free Software 18;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 19 20(define-module (test-suite test-load) 21 #:use-module (test-suite lib) 22 #:use-module (test-suite guile-test) 23 #:use-module (system base compile)) 24 25(define temp-dir (data-file-name "load-test.dir")) 26 27(define (create-tree parent tree) 28 (let loop ((parent parent) 29 (tree tree)) 30 (if (pair? tree) 31 (let ((elt (car tree))) 32 (cond 33 34 ;; A string means to create an empty file with that name. 35 ((string? elt) 36 (close-port (open-file (string-append parent "/" elt) "w"))) 37 38 ;; A list means to create a directory, and then create files 39 ;; within it. 40 ((pair? elt) 41 (let ((dirname (string-append parent "/" (car elt)))) 42 (mkdir dirname) 43 (loop dirname (cdr elt)))) 44 45 (else 46 (error "create-tree: bad tree structure"))) 47 48 (loop parent (cdr tree)))))) 49 50(define (delete-tree tree) 51 (cond 52 ((file-is-directory? tree) 53 (let ((dir (opendir tree))) 54 (let loop () 55 (let ((entry (readdir dir))) 56 (cond 57 ((member entry '("." "..")) 58 (loop)) 59 ((not (eof-object? entry)) 60 (let ((name (string-append tree "/" entry))) 61 (delete-tree name) 62 (loop)))))) 63 (closedir dir) 64 (rmdir tree))) 65 ((file-exists? tree) 66 (delete-file tree)) 67 (else 68 (error "delete-tree: can't delete " tree)))) 69 70(define (try-search-with-extensions path input extensions expected) 71 (let ((test-name (call-with-output-string 72 (lambda (port) 73 (display "search-path for " port) 74 (write input port) 75 (if (pair? extensions) 76 (begin 77 (display " with extensions " port) 78 (write extensions port))) 79 (display " yields " port) 80 (write expected port))))) 81 (let ((result (search-path path input extensions))) 82 (pass-if test-name 83 (equal? (if (string? expected) 84 (string-append temp-dir "/" expected) 85 expected) 86 result))))) 87 88(define (try-search path input expected) 89 (try-search-with-extensions path input '() expected)) 90 91;; Create a bunch of files for use in testing. 92(mkdir temp-dir) 93(create-tree temp-dir 94 '(("dir1" "foo.scm" "bar.scm" "ugly.scm.scm" 95 ("subdir1")) 96 ("dir2" "foo.scm" "baz.scm" "baz.ss" "ugly.scm.ss") 97 ("dir3" "ugly.scm" "ugly.ss.scm"))) 98 99;; Try some searches without extensions. 100(define path (list 101 (string-append temp-dir "/dir1") 102 (string-append temp-dir "/dir2") 103 (string-append temp-dir "/dir3"))) 104 105(try-search path "foo.scm" "dir1/foo.scm") 106(try-search path "bar.scm" "dir1/bar.scm") 107(try-search path "baz.scm" "dir2/baz.scm") 108(try-search path "baz.ss" "dir2/baz.ss") 109(try-search path "ugly.scm" "dir3/ugly.scm") 110(try-search path "subdir1" #f) 111 112(define extensions '(".ss" ".scm" "")) 113(try-search-with-extensions path "foo" extensions "dir1/foo.scm") 114(try-search-with-extensions path "bar" extensions "dir1/bar.scm") 115(try-search-with-extensions path "baz" extensions "dir2/baz.ss") 116(try-search-with-extensions path "ugly.scm" extensions "dir3/ugly.scm") 117(try-search-with-extensions path "ugly.ss" extensions #f) 118 119;; Check that search-path accepts Elisp nil-terminated lists for 120;; PATH and EXTENSIONS. 121(with-test-prefix "elisp-nil" 122 (set-cdr! (last-pair path) 123#nil) 124 (set-cdr! (last-pair extensions) #nil) 125 (try-search-with-extensions path "ugly.scm" extensions "dir3/ugly.scm") 126 (try-search-with-extensions path "ugly.ss" extensions #f)) 127 128(with-test-prefix "return value of `load'" 129 (let ((temp-file (in-vicinity temp-dir "foo.scm"))) 130 (call-with-output-file temp-file 131 (lambda (port) 132 (write '(+ 2 3) port) 133 (newline port))) 134 (pass-if "primitive-load" 135 (equal? 5 (primitive-load temp-file))) 136 (let ((temp-compiled-file (in-vicinity temp-dir "foo.go"))) 137 (compile-file temp-file #:output-file temp-compiled-file) 138 (pass-if "load-compiled" 139 (equal? 5 (load-compiled temp-compiled-file)))))) 140 141(delete-tree temp-dir) 142