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 Diff line number Diff line
@@ -151,6 +151,7 @@
           #:clear-output-translations
           #:ensure-output-translations
           #:apply-output-translations
           #:compile-file-pathname*

           #:initialize-source-registry
           #:clear-source-registry
@@ -186,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.596" (1+ (length "VERSION"))))
  (subseq "VERSION:1.600" (1+ (length "VERSION"))))

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

(defmethod apply-output-translations (path)
(defun apply-output-translations (path)
  (ensure-output-translations)
  (setf path (truenamize path))
  (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"
  (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:
+2 −3
Original line number Diff line number Diff line
@@ -33,8 +33,8 @@ if [ $? -eq 0 ] ; then
    test_pass=0
    test_fail=0
    failed_list=""
    for i in $scripts ; 
    do 
    for i in $scripts ;
    do
      echo "Testing: $i" >&2
      test_count=`expr "$test_count" + 1`
      rm -f *.$2 || true
@@ -134,4 +134,3 @@ else
    do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
    clean_up
fi
 
+2 −5
Original line number Diff line number Diff line
@@ -3,9 +3,6 @@
#+allegro
(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!)
;; http://www.cliki.net/cl-launch
(defun leave-lisp (message return)
@@ -17,7 +14,7 @@
  (ext:quit return)
  #+(or cmu scl)
  (unix:unix-exit code)
  #+ecl 
  #+ecl
  (si:quit return)
  #+gcl
  (lisp:quit code)
@@ -31,7 +28,7 @@
  (error "Don't know how to quit Lisp; wanting to use exit code ~a" return))

(defmacro quit-on-error (&body body)
  `(handler-case 
  `(handler-case
      (progn ,@body
             (leave-lisp "~&Script succeeded~%" 0))
    (error (c)
+5 −6
Original line number Diff line number Diff line
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(quit-on-error 
(quit-on-error
 (setf asdf:*central-registry* '(*default-pathname-defaults*))

 (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
 (sleep 1)
 (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
 (sleep 1)
 (asdf:operate 'asdf:load-op 'test-force :force t)
 (assert (> (file-write-date (compile-file-pathname "file1")) file1-date))
 )
 No newline at end of file
 (assert (> (file-write-date (asdf:compile-file-pathname* "file1")) file1-date)))
+5 −6
Original line number Diff line number Diff line
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(quit-on-error 
(quit-on-error
 (setf asdf:*central-registry* '(*default-pathname-defaults*))

 (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
 (setf asdf::*defined-systems* (make-hash-table :test 'equal))
  

 ;; date should stay same
 (sleep 1)
 (asdf:operate 'asdf:load-op 'static-and-serial)
 (assert (= (file-write-date (compile-file-pathname "file1")) file1-date))
 )
 No newline at end of file
 (assert (= (file-write-date (asdf:compile-file-pathname* "file1")) file1-date)))
Loading