From 8274417aab692de78fbed6b7da6e1486a7e498a6 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 13 Apr 2005 12:37:35 +0000 Subject: [PATCH] Tests for LOAD --- ansi-tests/load-system-construction.lsp | 1 + ansi-tests/load-test-file-2.lsp | 7 + ansi-tests/load-test-file.lsp | 9 ++ ansi-tests/load.lsp | 188 ++++++++++++++++++++++-- 4 files changed, 193 insertions(+), 12 deletions(-) create mode 100644 ansi-tests/load-test-file-2.lsp create mode 100644 ansi-tests/load-test-file.lsp diff --git a/ansi-tests/load-system-construction.lsp b/ansi-tests/load-system-construction.lsp index 9b672063..62551216 100644 --- a/ansi-tests/load-system-construction.lsp +++ b/ansi-tests/load-system-construction.lsp @@ -6,5 +6,6 @@ (in-package :cl-test) (load "compile-file.lsp") +(load "load.lsp") diff --git a/ansi-tests/load-test-file-2.lsp b/ansi-tests/load-test-file-2.lsp new file mode 100644 index 00000000..d2941cc9 --- /dev/null +++ b/ansi-tests/load-test-file-2.lsp @@ -0,0 +1,7 @@ +(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*)) + diff --git a/ansi-tests/load-test-file.lsp b/ansi-tests/load-test-file.lsp new file mode 100644 index 00000000..2e56d2a9 --- /dev/null +++ b/ansi-tests/load-test-file.lsp @@ -0,0 +1,9 @@ +(in-package :cl-test) + +(defun load-file-test-fun.1 () + '#.*load-pathname*) + +(defun load-file-test-fun.2 () + '#.*load-truename*) + + diff --git a/ansi-tests/load.lsp b/ansi-tests/load.lsp index af6f6177..1c8bfbdb 100644 --- a/ansi-tests/load.lsp +++ b/ansi-tests/load.lsp @@ -1,15 +1,179 @@ -;; 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) -- GitLab