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