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 @@
(defun compile-file-pathname (pathname)
(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
the associated compiled file is out of date."
(let* ((pathname (pathname pathspec))
(former-data (assoc pathname *compiled-and-loaded-files*
:test #'equalp))
(compile-pathname (compile-file-pathname pathname))
(source-write-time (file-write-date pathname))
(target-write-time (and (probe-file compile-pathname)
(file-write-date compile-pathname))))
(when (or (not target-write-time)
(<= target-write-time source-write-time))
(compile-file pathname))
(load compile-pathname)))
;;; On-demand compile and load
(defvar *compiled-and-loaded-files* nil
"List containing pathname, creation times for files that have already
been loaded.")
(unless (and (not force)
former-data
(<= (cadr former-data) source-write-time))
(when (or (not target-write-time)
(<= target-write-time source-write-time))
(compile-file pathname))
(if former-data
(setf (cadr former-data) source-write-time)
(push (list pathname source-write-time) *compiled-and-loaded-files*))
(load compile-pathname))))
......@@ -51,5 +51,6 @@
(load "define-method-combination.lsp")
(load "find-method.lsp")
(load "add-method.lsp")
(load "unbound-slot.lsp")
(load "class-name.lsp")
(load "class-of.lsp")
(load "unbound-slot.lsp")
......@@ -5,6 +5,8 @@
(in-package :cl-test)
(compile-and-load "search-aux.lsp")
(deftest search-bitvector.1
(let ((target *searched-bitvector*)
(pat #*0))
......
......@@ -5,6 +5,8 @@
(in-package :cl-test)
(compile-and-load "search-aux.lsp")
(deftest search-list.1
(let ((target *searched-list*)
(pat '(a)))
......
......@@ -5,6 +5,8 @@
(in-package :cl-test)
(compile-and-load "search-aux.lsp")
;;; The next test was busted due to to a stupid cut and paste
;;; error. The loop terminates immediately, doing nothing
;;; useful. -- PFD
......
......@@ -5,6 +5,8 @@
(in-package :cl-test)
(compile-and-load "search-aux.lsp")
(deftest search-vector.1
(let ((target *searched-vector*)
(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