Commit ba7434a4 authored by pfdietz's avatar pfdietz

Add extra class-of tests. Make compile-and-load remember what's been loaded...

Add extra class-of tests.  Make compile-and-load remember what's been loaded and reload only when necessary (this will let me put a compile-and-load into files that require aux files, so it won't be necessary to compile/load the aux files separately.  See search-*.lsp for examples.)
parent 00c8da1c
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Jun 16 19:40:32 2003
;;;; Contains: Tests of CLASS-OF
(in-package :cl-test)
;;; Most tests of CLASS-OF are in other files
(deftest class-of.error.1
(classify-error (class-of))
program-error)
(deftest class-of.error.2
(classify-error (class-of nil nil))
program-error)
...@@ -12,24 +12,29 @@ ...@@ -12,24 +12,29 @@
(defun compile-file-pathname (pathname) (defun compile-file-pathname (pathname)
(make-pathname :defaults pathname :type "o")))) (make-pathname :defaults pathname :type "o"))))
(defun compile-and-load (pathspec) ;;; On-demand compile and load
(defvar *compiled-and-loaded-files* nil
"List containing pathname, creation times for files that have already
been loaded.")
(defun compile-and-load (pathspec &key force)
"Find the file indicated by PATHSPEC, compiling it first if "Find the file indicated by PATHSPEC, compiling it first if
the associated compiled file is out of date." the associated compiled file is out of date."
(let* ((pathname (pathname pathspec)) (let* ((pathname (pathname pathspec))
(former-data (assoc pathname *compiled-and-loaded-files*
:test #'equalp))
(compile-pathname (compile-file-pathname pathname)) (compile-pathname (compile-file-pathname pathname))
(source-write-time (file-write-date pathname)) (source-write-time (file-write-date pathname))
(target-write-time (and (probe-file compile-pathname) (target-write-time (and (probe-file compile-pathname)
(file-write-date compile-pathname)))) (file-write-date compile-pathname))))
(when (or (not target-write-time) (unless (and (not force)
(<= target-write-time source-write-time)) former-data
(compile-file pathname)) (<= (cadr former-data) source-write-time))
(load compile-pathname))) (when (or (not target-write-time)
(<= target-write-time source-write-time))
;;; On-demand compile and load (compile-file pathname))
(if former-data
(defvar *compiled-and-loaded-files* nil (setf (cadr former-data) source-write-time)
"List containing pathname, creation times for files that have already (push (list pathname source-write-time) *compiled-and-loaded-files*))
been loaded.") (load compile-pathname))))
...@@ -51,5 +51,6 @@ ...@@ -51,5 +51,6 @@
(load "define-method-combination.lsp") (load "define-method-combination.lsp")
(load "find-method.lsp") (load "find-method.lsp")
(load "add-method.lsp") (load "add-method.lsp")
(load "unbound-slot.lsp")
(load "class-name.lsp") (load "class-name.lsp")
(load "class-of.lsp")
(load "unbound-slot.lsp")
...@@ -5,6 +5,8 @@ ...@@ -5,6 +5,8 @@
(in-package :cl-test) (in-package :cl-test)
(compile-and-load "search-aux.lsp")
(deftest search-bitvector.1 (deftest search-bitvector.1
(let ((target *searched-bitvector*) (let ((target *searched-bitvector*)
(pat #*0)) (pat #*0))
......
...@@ -5,6 +5,8 @@ ...@@ -5,6 +5,8 @@
(in-package :cl-test) (in-package :cl-test)
(compile-and-load "search-aux.lsp")
(deftest search-list.1 (deftest search-list.1
(let ((target *searched-list*) (let ((target *searched-list*)
(pat '(a))) (pat '(a)))
......
...@@ -5,6 +5,8 @@ ...@@ -5,6 +5,8 @@
(in-package :cl-test) (in-package :cl-test)
(compile-and-load "search-aux.lsp")
;;; The next test was busted due to to a stupid cut and paste ;;; The next test was busted due to to a stupid cut and paste
;;; error. The loop terminates immediately, doing nothing ;;; error. The loop terminates immediately, doing nothing
;;; useful. -- PFD ;;; useful. -- PFD
......
...@@ -5,6 +5,8 @@ ...@@ -5,6 +5,8 @@
(in-package :cl-test) (in-package :cl-test)
(compile-and-load "search-aux.lsp")
(deftest search-vector.1 (deftest search-vector.1
(let ((target *searched-vector*) (let ((target *searched-vector*)
(pat #(a))) (pat #(a)))
......
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