;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Tue Apr 12 21:51:49 2005 ;;;; Contains: Tests of LOAD (in-package :cl-test) (defun load-file-test (file funname &rest args &key if-does-not-exist (print nil print-p) (verbose nil verbose-p) (*load-print* nil) (*load-verbose* nil) external-format) (declare (ignorable external-format if-does-not-exist print print-p verbose verbose-p)) (fmakunbound funname) (let* ((str (make-array '(0) :element-type 'character :adjustable t :fill-pointer 0)) (vals (multiple-value-list (with-output-to-string (*standard-output* str) (apply #'load file :allow-other-keys t args)))) (print? (if print-p print *load-print*)) (verbose? (if verbose-p verbose *load-verbose*))) (values (let ((v1 (car vals)) (v2 (or (and verbose-p (not verbose)) (and (not verbose-p) (not *load-verbose*)) (position #\; str))) (v3 (or (and print-p (not print)) (and (not print-p) (not *load-print*)) (> (length str) 0))) (v4 (if (or print? verbose?) (> (length str) 0) t))) (if (and (= (length vals) 1) v1 v2 v3 v4) t (list vals v2 v3 v4 str))) (funcall funname)))) (deftest load.1 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1) t nil) (deftest load.2 (load-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1) t nil) (deftest load.3 (with-input-from-string (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") (load-file-test s 'load-file-test-fun.2)) t good) (deftest load.4 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :external-format :default) t nil) (deftest load.5 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :verbose t) t nil) (deftest load.6 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :*load-verbose* t) t nil) (deftest load.7 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :*load-verbose* t :verbose nil) t nil) (deftest load.8 (with-input-from-string (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") (load-file-test s 'load-file-test-fun.2 :verbose t)) t good) (deftest load.9 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :print t) t nil) (deftest load.10 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :*load-print* t) t nil) (deftest load.11 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :*load-print* t :print nil) t nil) (deftest load.12 (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 :*load-print* nil :print t) t nil) (deftest load.13 (with-input-from-string (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") (load-file-test s 'load-file-test-fun.2 :print t)) t good) (deftest load.14 (load "nonexistent-file.lsp" :if-does-not-exist nil) nil) (defpackage LOAD-TEST-PACKAGE (:use "COMMON-LISP")) (deftest load.15 (let ((*package* (find-package "LOAD-TEST-PACKAGE"))) (with-input-from-string (s "(defun f () 'good)") (load-file-test s 'load-test-package::f))) t load-test-package::good) (deftest load.15a (let ((*package* (find-package "CL-TEST"))) (values (with-input-from-string (s "(eval-when (:load-toplevel :execute) (setq *package* (find-package \"LOAD-TEST-PACKAGE\"))) (defun f () 'good)") (multiple-value-list (load-file-test s 'load-test-package::f))) (read-from-string "GOOD"))) (t load-test-package::good) good) (deftest load.16 (let ((*readtable* (copy-readtable nil))) (set-macro-character #\! (get-macro-character #\')) (with-input-from-string (s "(in-package :cl-test) (defun load-file-test-fun.3 () !good)") (load-file-test s 'load-file-test-fun.3))) t good) (deftest load.16a (let ((*readtable* *readtable*) (*package* (find-package "CL-TEST"))) (values (with-input-from-string (s "(in-package :cl-test) (eval-when (:load-toplevel :execute) (setq *readtable* (copy-readtable nil)) (set-macro-character #\\! (get-macro-character #\\'))) (defun load-file-test-fun.3 () !good)") (multiple-value-list (load-file-test s 'load-file-test-fun.3))) (read-from-string "!FOO"))) (t good) !FOO) (deftest load.17 (let ((file #p"load-test-file.lsp")) (fmakunbound 'load-file-test-fun.1) (fmakunbound 'load-file-test-fun.2) (values (notnot (load file)) #+bogus-test (let ((p1 (pathname (merge-pathnames file))) (p2 (funcall 'load-file-test-fun.1))) (equalpt-or-report p1 p2)) (let ((p1 (truename file)) (p2 (funcall 'load-file-test-fun.2))) (equalpt-or-report p1 p2)))) t #+bogus-test t t) ;;; Test that the load pathname/truename variables are bound ;;; properly when loading compiled files (deftest load.18 (let* ((file "load-test-file-2.lsp") (target (enough-namestring (compile-file-pathname file)))) (declare (special *load-test-var.1* *load-test-var.2*)) (compile-file file) (makunbound '*load-test-var.1*) (makunbound '*load-test-var.2*) (load target) (values #+bogus-test (let ((p1 (pathname (merge-pathnames target))) (p2 *load-test-var.1*)) (equalpt-or-report p1 p2)) (let ((p1 (truename target)) (p2 *load-test-var.2*)) (equalpt-or-report p1 p2)))) #+bogus-test t t) (deftest load.19 (let ((file (logical-pathname "CLTEST:LDTEST.LSP")) (fn 'load-test-fun-3) (*package* (find-package "CL-TEST"))) (with-open-file (s file :direction :output :if-exists :supersede :if-does-not-exist :create) (format s "(in-package :cl-test) (defun ~a () :foo)" fn)) (fmakunbound fn) (values (notnot (load file)) (funcall fn))) t :foo) ;;; Defaults of the load variables (deftest load-pathname.1 *load-pathname* nil) (deftest load-truename.1 *load-truename* nil) (deftest load-print.1 *load-print* nil) ;;; Error tests (deftest load.error.1 (signals-error (load "nonexistent-file.lsp") file-error) t) (deftest load.error.2 (signals-error (load) program-error) t) (deftest load.error.3 (signals-error (load "compile-file-test-file.lsp" :bad-key-arg t) program-error) t)