Commit 8274417a authored by pfdietz's avatar pfdietz

Tests for LOAD

parent 984179d4
......@@ -6,5 +6,6 @@
(in-package :cl-test)
(load "compile-file.lsp")
(load "load.lsp")
(in-package :cl-test)
(declaim (special *load-test-var.1* *load-test-var.2*))
(eval-when (:load-toplevel)
(setq *load-test-var.1* *load-pathname*)
(setq *load-test-var.2* *load-truename*))
(in-package :cl-test)
(defun load-file-test-fun.1 ()
'#.*load-pathname*)
(defun load-file-test-fun.2 ()
'#.*load-truename*)
;; Get the MK package
;; I've hardwired a path here; fix for your system
;; I assume the package is already compiled.
(unless (find-package "MK")
(load #.(concatenate 'string "../defsys30/defsystem."
#+cmu (C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*)
#+allegro "fasl"
#+(or akcl gcl) "o")))
(load "rt/rt.system")
(mk::load-system "rt")
(mk::compile-system "cltest")
;-*- 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.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.17
(let ((file #p"load-test-file.lsp"))
(values
(notnot (load file))
(let ((p1 (pathname (merge-pathnames file)))
(p2 (load-file-test-fun.1)))
(or (equalpt p1 p2)
(list p1 p2)))
(let ((p1 (truename file))
(p2 (load-file-test-fun.2)))
(or (equalpt p1 p2)
(list p1 p2)))))
t 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
(let ((p1 (pathname (merge-pathnames target)))
(p2 *load-test-var.1*))
(or (equalpt p1 p2)
(list p1 p2)))
(let ((p1 (truename target))
(p2 *load-test-var.2*))
(or (equalpt p1 p2)
(list p1 p2)))))
t t)
;;; Add logical pathname test
;;; 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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment