Commit 200eb7f6 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

export COMPILE-FILE-PATHNAME* that applies translations. Use it to fix tests.

parent 81429606
Loading
Loading
Loading
Loading
+6 −2
Original line number Original line Diff line number Diff line
@@ -151,6 +151,7 @@
           #:clear-output-translations
           #:clear-output-translations
           #:ensure-output-translations
           #:ensure-output-translations
           #:apply-output-translations
           #:apply-output-translations
           #:compile-file-pathname*


           #:initialize-source-registry
           #:initialize-source-registry
           #:clear-source-registry
           #:clear-source-registry
@@ -186,7 +187,7 @@
;;;;
;;;;
(defparameter *asdf-version*
(defparameter *asdf-version*
  ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
  ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
  (subseq "VERSION:1.596" (1+ (length "VERSION"))))
  (subseq "VERSION:1.600" (1+ (length "VERSION"))))


(defun asdf-version ()
(defun asdf-version ()
  *asdf-version*)
  *asdf-version*)
@@ -2244,7 +2245,7 @@ with a different configuration, so the configuration would be re-read then."
      (output-translations)
      (output-translations)
      (initialize-output-translations)))
      (initialize-output-translations)))


(defmethod apply-output-translations (path)
(defun apply-output-translations (path)
  (ensure-output-translations)
  (ensure-output-translations)
  (setf path (truenamize path))
  (setf path (truenamize path))
  (loop :for (source destination) :in (car *output-translations*)
  (loop :for (source destination) :in (car *output-translations*)
@@ -2256,6 +2257,9 @@ with a different configuration, so the configuration would be re-read then."
  "Method to rewrite output files to fasl-root"
  "Method to rewrite output files to fasl-root"
  (mapcar #'apply-output-translations (call-next-method)))
  (mapcar #'apply-output-translations (call-next-method)))


(defun compile-file-pathname* (input-file &rest keys)
  (apply-output-translations
   (apply #'compile-file-pathname input-file keys)))


;;;; -----------------------------------------------------------------
;;;; -----------------------------------------------------------------
;;;; Windows shortcut support.  Based on:
;;;; Windows shortcut support.  Based on:
+2 −3
Original line number Original line Diff line number Diff line
@@ -134,4 +134,3 @@ else
    do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
    do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
    clean_up
    clean_up
fi
fi
 
+2 −5
Original line number Original line Diff line number Diff line
@@ -3,9 +3,6 @@
#+allegro
#+allegro
(setf excl:*warn-on-nested-reader-conditionals* nil)
(setf excl:*warn-on-nested-reader-conditionals* nil)


#+common-lisp-controller
(setf common-lisp-controller:*redirect-fasl-files-to-cache* nil)

;;; code adapted from cl-launch (any errors in transcription are mine!)
;;; code adapted from cl-launch (any errors in transcription are mine!)
;; http://www.cliki.net/cl-launch
;; http://www.cliki.net/cl-launch
(defun leave-lisp (message return)
(defun leave-lisp (message return)
+5 −6
Original line number Original line Diff line number Diff line
@@ -5,16 +5,15 @@
 (setf asdf:*central-registry* '(*default-pathname-defaults*))
 (setf asdf:*central-registry* '(*default-pathname-defaults*))


 (asdf:operate 'asdf:load-op 'test-force)
 (asdf:operate 'asdf:load-op 'test-force)
 (defvar file1-date (file-write-date (compile-file-pathname "file1"))))
 (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1"))))


(quit-on-error
(quit-on-error
 ;; unforced, date should stay same
 ;; unforced, date should stay same
 (sleep 1)
 (sleep 1)
 (asdf:operate 'asdf:load-op 'test-force)
 (asdf:operate 'asdf:load-op 'test-force)
 (assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
 (assert (= (file-write-date (asdf:compile-file-pathname* "file1")) file1-date))


 ;; forced, it should be later
 ;; forced, it should be later
 (sleep 1)
 (sleep 1)
 (asdf:operate 'asdf:load-op 'test-force :force t)
 (asdf:operate 'asdf:load-op 'test-force :force t)
 (assert (> (file-write-date (compile-file-pathname "file1")) file1-date))
 (assert (> (file-write-date (asdf:compile-file-pathname* "file1")) file1-date)))
 )
 No newline at end of file
+5 −6
Original line number Original line Diff line number Diff line
@@ -5,7 +5,7 @@
 (setf asdf:*central-registry* '(*default-pathname-defaults*))
 (setf asdf:*central-registry* '(*default-pathname-defaults*))


 (asdf:operate 'asdf:load-op 'static-and-serial)
 (asdf:operate 'asdf:load-op 'static-and-serial)
 (defvar file1-date (file-write-date (compile-file-pathname "file1"))))
 (defvar file1-date (file-write-date (asdf:compile-file-pathname* "file1"))))


(quit-on-error
(quit-on-error
 ;; cheat
 ;; cheat
@@ -14,5 +14,4 @@
 ;; date should stay same
 ;; date should stay same
 (sleep 1)
 (sleep 1)
 (asdf:operate 'asdf:load-op 'static-and-serial)
 (asdf:operate 'asdf:load-op 'static-and-serial)
 (assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
 (assert (= (file-write-date (asdf:compile-file-pathname* "file1")) file1-date)))
 )
 No newline at end of file
Loading