From 1250bbc5c6e3e507e1d81637ff278dac4708a649 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Sat, 6 Feb 2010 14:44:26 -0500 Subject: [PATCH] Use truenamize in compile-file-pathname* Simplify test scripts. --- asdf.lisp | 6 ++++-- test/compile-asdf.lisp | 9 +++++---- test/script-support.lisp | 4 ++++ test/test-force.script | 4 ++-- test/test-module-pathnames.script | 2 +- test/test-nested-components.script | 2 +- test/test-package.script | 2 +- test/test-retry-loading-component-1.script | 2 +- test/test-static-and-serial.script | 2 +- test/test-touch-system-1.script | 2 +- test/test-touch-system-2.script | 2 +- test/test-try-recompiling-1.script | 2 +- test/test-utilities.script | 2 +- test/test-version.script | 2 +- test/test1.script | 6 +++--- test/test2.script | 2 +- test/test3.script | 2 +- test/test4.script | 2 +- test/test8.script | 2 +- test/test9.script | 2 +- test/wild-module.script | 4 ++-- 21 files changed, 35 insertions(+), 28 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 7ec46564..6a7b67be 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -187,7 +187,7 @@ ;;;; (defparameter *asdf-version* ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace - (subseq "VERSION:1.604" (1+ (length "VERSION")))) + (subseq "VERSION:1.605" (1+ (length "VERSION")))) (defun asdf-version () *asdf-version*) @@ -2259,7 +2259,9 @@ with a different configuration, so the configuration would be re-read then." (defun compile-file-pathname* (input-file &rest keys) (apply-output-translations - (apply #'compile-file-pathname input-file keys))) + (apply #'compile-file-pathname + (truenamize (merge-pathnames (make-pathname :type "lisp") input-file)) + keys))) ;;;; ----------------------------------------------------------------- ;;;; Windows shortcut support. Based on: diff --git a/test/compile-asdf.lisp b/test/compile-asdf.lisp index 0f896971..dc171c2c 100644 --- a/test/compile-asdf.lisp +++ b/test/compile-asdf.lisp @@ -1,15 +1,17 @@ (in-package #:common-lisp-user) -(load "test/script-support.lisp") +(load (merge-pathnames "script-support" *load-pathname*)) -(cond ((probe-file "asdf.lisp") +(cond ((probe-file *asdf-lisp*) + (ensure-directories-exist *asdf-fasl*) (multiple-value-bind (result warnings-p errors-p) ;; style warnings shouldn't abort the compilation [2010/02/03:rpg] (handler-bind ((style-warning #'(lambda (w) (princ w *error-output*) (muffle-warning w)))) - (compile-file "asdf.lisp")) + (compile-file *asdf-lisp* + :output-file *asdf-fasl*)) (declare (ignore result)) (cond (warnings-p ;;; ECL gives warnings that it shouldn't! @@ -22,4 +24,3 @@ (leave-lisp "ASDF compiled cleanly" 0))))) (t (leave-lisp "Testsuite failed: unable to find ASDF source" 3))) - diff --git a/test/script-support.lisp b/test/script-support.lisp index deb4013a..37c63eb8 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -1,5 +1,9 @@ (in-package #:common-lisp-user) +(defvar *asdf-lisp* (truename (merge-pathnames "../asdf.lisp" *load-truename*))) +(defvar *asdf-fasl* (compile-file-pathname (merge-pathnames "tmp/" *asdf-lisp*))) +(defun load-asdf () (load *asdf-fasl*)) + #+allegro (setf excl:*warn-on-nested-reader-conditionals* nil) diff --git a/test/test-force.script b/test/test-force.script index 47e8569b..ee35beaa 100644 --- a/test/test-force.script +++ b/test/test-force.script @@ -1,12 +1,12 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:operate 'asdf:load-op 'test-force) - (let* ((file1 (asdf:compile-file-pathname* (truename "file1.lisp"))) + (let* ((file1 (asdf:compile-file-pathname* "file1")) (file1-date (file-write-date file1))) (assert file1) diff --git a/test/test-module-pathnames.script b/test/test-module-pathnames.script index d7a19953..fee40aa9 100644 --- a/test/test-module-pathnames.script +++ b/test/test-module-pathnames.script @@ -1,6 +1,6 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) diff --git a/test/test-nested-components.script b/test/test-nested-components.script index c8983b19..beaaf7b5 100644 --- a/test/test-nested-components.script +++ b/test/test-nested-components.script @@ -3,7 +3,7 @@ ;;; check that added nesting via modules doesn't confuse ASDF (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (in-package #:common-lisp-user) (quit-on-error diff --git a/test/test-package.script b/test/test-package.script index f1f50175..861fbc1a 100644 --- a/test/test-package.script +++ b/test/test-package.script @@ -1,7 +1,7 @@ ;;; -*- Lisp -*- (in-package :cl-user) (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (defun module () 1) (load "test-package.asd") diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index a4f3a6e2..7495f747 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -3,7 +3,7 @@ ;;; test asdf:try-recompiling restart (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) ;(trace asdf::find-component) ;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate) ;#+allegro diff --git a/test/test-static-and-serial.script b/test/test-static-and-serial.script index a5138196..6e20a0cb 100644 --- a/test/test-static-and-serial.script +++ b/test/test-static-and-serial.script @@ -1,6 +1,6 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script index 250ce9b6..9480c292 100644 --- a/test/test-touch-system-1.script +++ b/test/test-touch-system-1.script @@ -4,7 +4,7 @@ ;;; system that can be found using *system-definition-search-functions* (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (flet ((system-load-time (name) (let ((data (asdf::system-registered-p name))) diff --git a/test/test-touch-system-2.script b/test/test-touch-system-2.script index cf43f236..04b90195 100644 --- a/test/test-touch-system-2.script +++ b/test/test-touch-system-2.script @@ -4,7 +4,7 @@ ;;; system that canNOT be found using *system-definition-search-functions* (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (flet ((system-load-time (name) (let ((data (asdf::system-registered-p name))) diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script index 85dbf8d6..ac1ad293 100644 --- a/test/test-try-recompiling-1.script +++ b/test/test-try-recompiling-1.script @@ -3,7 +3,7 @@ ;;; test asdf:try-recompiling restart (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (defvar *caught-error* nil) (quit-on-error diff --git a/test/test-utilities.script b/test/test-utilities.script index 5dadd639..19eacc18 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -1,6 +1,6 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (in-package :asdf) (cl-user::quit-on-error diff --git a/test/test-version.script b/test/test-version.script index 621e009d..d1d11488 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -1,6 +1,6 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (setf asdf:*central-registry* '(*default-pathname-defaults*)) (defpackage :test-version-system diff --git a/test/test1.script b/test/test1.script index b759ea5c..d22190c7 100644 --- a/test/test1.script +++ b/test/test1.script @@ -1,14 +1,14 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) (asdf:operate 'asdf:load-op 'test1) ;; test that it compiled - (let* ((file1 (asdf:compile-file-pathname* (truename "file1.lisp"))) - (file2 (asdf:compile-file-pathname* (truename "file2.lisp"))) + (let* ((file1 (asdf:compile-file-pathname* "file1")) + (file2 (asdf:compile-file-pathname* "file2")) (file1-date (file-write-date file1))) (format t "~&test1 1: ~S ~S~%" file1 file1-date) diff --git a/test/test2.script b/test/test2.script index d2c75e98..4fcfb093 100644 --- a/test/test2.script +++ b/test/test2.script @@ -1,6 +1,6 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error (format t "test2 1~%") (setf asdf:*central-registry* '(*default-pathname-defaults*)) diff --git a/test/test3.script b/test/test3.script index 3686261f..5fe09acd 100644 --- a/test/test3.script +++ b/test/test3.script @@ -2,7 +2,7 @@ #+(or f1 f2) (error "This test cannot run if :f1 or :f2 are on *features*") (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (in-package :asdf) (cl-user::quit-on-error (let ((fasl1 (asdf:compile-file-pathname* (truename "file1.lisp"))) diff --git a/test/test4.script b/test/test4.script index d9213413..4488347f 100644 --- a/test/test4.script +++ b/test/test4.script @@ -1,7 +1,7 @@ ;;; -*- Lisp -*- ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (in-package :asdf) (cl-user::quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) diff --git a/test/test8.script b/test/test8.script index d6338b92..50f00f94 100644 --- a/test/test8.script +++ b/test/test8.script @@ -3,7 +3,7 @@ ;;; make sure we get a missing-component error (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (in-package #:common-lisp-user) (quit-on-error diff --git a/test/test9.script b/test/test9.script index eeaf1a80..35b3cc78 100644 --- a/test/test9.script +++ b/test/test9.script @@ -3,7 +3,7 @@ ;;; make sure we get a missing-component-of-version error (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (in-package #:common-lisp-user) (quit-on-error diff --git a/test/wild-module.script b/test/wild-module.script index 8db0160a..997203b1 100644 --- a/test/wild-module.script +++ b/test/wild-module.script @@ -1,8 +1,8 @@ ;;; -*- Lisp -*- (load "script-support") -(load (compile-file-pathname "../asdf")) +(load-asdf) (quit-on-error - (load (compile-file-pathname "../asdf")) + (load-asdf) (load "../wild-modules") (setf asdf:*central-registry* '(*default-pathname-defaults*)) -- GitLab