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