Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asdf
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Pascal J. Bourguignon
asdf
Commits
200eb7f6
Commit
200eb7f6
authored
Feb 03, 2010
by
Francois-Rene Rideau
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
export COMPILE-FILE-PATHNAME* that applies translations. Use it to fix tests.
parent
81429606
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
44 additions
and
48 deletions
+44
-48
asdf.lisp
asdf.lisp
+6
-2
test/run-tests.sh
test/run-tests.sh
+2
-3
test/script-support.lisp
test/script-support.lisp
+2
-5
test/test-force.script
test/test-force.script
+5
-6
test/test-static-and-serial.script
test/test-static-and-serial.script
+5
-6
test/test1.script
test/test1.script
+11
-11
test/test2.script
test/test2.script
+7
-8
test/test3.script
test/test3.script
+6
-7
No files found.
asdf.lisp
View file @
200eb7f6
...
...
@@ -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
)))
(
def
method
apply-output-translations
(
path
)
(
def
un
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:
...
...
test/run-tests.sh
View file @
200eb7f6
...
...
@@ -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
test/script-support.lisp
View file @
200eb7f6
...
...
@@ -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
)
...
...
test/test-force.script
View file @
200eb7f6
;;; -*- 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)))
test/test-static-and-serial.script
View file @
200eb7f6
;;; -*- 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)))
test/test1.script
View file @
200eb7f6
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(quit-on-error
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'test1)
;; test that it compiled
(defvar file1-date (file-write-date (
compile-file-pathname "file1"
))))
(defvar file1-date (file-write-date (
asdf:compile-file-pathname* "file1")
))))
(quit-on-error
(assert (and file1-date (file-write-date (
compile-file-pathname "file2"
)))))
(quit-on-error
(assert (and file1-date (file-write-date (
asdf:compile-file-pathname* "file2")
)))))
;; and loaded
(assert test-package::*file1*)
(quit-on-error
(quit-on-error
;; now remove one output file and check that the other is _not_
;; recompiled
(sleep 1) ; mtime has 1-second granularity, so pause here for fast machines
(asdf::run-shell-command "rm -f ~A"
(namestring (
compile-file-pathname
"file2")))
(namestring (
asdf:compile-file-pathname*
"file2")))
(asdf:operate 'asdf:load-op 'test1)
(assert (= file1-date (file-write-date (
compile-file-pathname
"file1"))))
(assert (file-write-date (
compile-file-pathname
"file2")))
(assert (= file1-date (file-write-date (
asdf:compile-file-pathname*
"file1"))))
(assert (file-write-date (
asdf:compile-file-pathname*
"file2")))
;; now touch file1 and check that file2 _is_ also recompiled
;; XXX run-shell-command loses if *default-pathname-defaults* is not the
;; unix cwd. this is not a problem for run-tests.sh, but can be in general
(let ((before (file-write-date (
compile-file-pathname
"file2"))))
(let ((before (file-write-date (
asdf:compile-file-pathname*
"file2"))))
(asdf::run-shell-command "touch file1.lisp")
(sleep 1)
(asdf:operate 'asdf:load-op 'test1)
(assert (> (file-write-date (compile-file-pathname "file2")) before)))
)
\ No newline at end of file
(assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before))))
test/test2.script
View file @
200eb7f6
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(quit-on-error
(quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*))
;(trace asdf::perform)
;(trace asdf::find-component)
;(trace asdf::traverse)
(asdf:oos 'asdf:load-op 'test2b1)
(assert (and (probe-file (
compile-file-pathname
"file3"))
(probe-file (
compile-file-pathname
"file4"))))
(handler-case
(assert (and (probe-file (
asdf:compile-file-pathname*
"file3"))
(probe-file (
asdf:compile-file-pathname*
"file4"))))
(handler-case
(asdf:oos 'asdf:load-op 'test2b2)
(asdf:missing-dependency (c)
(format t "load failed as expected: - ~%~A~%" c))
(:no-error (c)
(declare (ignore c))
(error "should have failed, oops")))
(handler-case
(handler-case
(asdf:oos 'asdf:load-op 'test2b3)
(asdf:missing-dependency (c)
(format t "load failed as expected: - ~%~A~%" c))
(:no-error (c)
(:no-error (c)
(declare (ignore c))
(error "should have failed, oops")))
)
\ No newline at end of file
(error "should have failed, oops"))))
test/test3.script
View file @
200eb7f6
...
...
@@ -4,18 +4,18 @@
(load "script-support")
(load "../asdf")
(in-package :asdf)
(cl-user::quit-on-error
(let ((fasl1 (
compile-file-pathname
(merge-pathnames "file1")))
(fasl2 (
compile-file-pathname
(merge-pathnames "file2"))))
(cl-user::quit-on-error
(let ((fasl1 (
asdf:compile-file-pathname*
(merge-pathnames "file1")))
(fasl2 (
asdf:compile-file-pathname*
(merge-pathnames "file2"))))
(asdf:run-shell-command "rm -f ~A ~A"
(namestring fasl1)
(namestring fasl2))
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(handler-case
(handler-case
(asdf:oos 'asdf:load-op 'test3)
(asdf:missing-dependency (c)
(format t "first test failed as expected: - ~%~A~%" c))
(:no-error (c)
(:no-error (c)
(declare (ignore c))
(error "should have failed, oops")))
(pushnew :f1 *features*)
...
...
@@ -26,5 +26,4 @@
(setf *features* (cons :f2 (cdr *features*)))
(asdf:oos 'asdf:load-op 'test3)
(assert (probe-file fasl2))
(assert (not (probe-file fasl1)))
))
(assert (not (probe-file fasl1)))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment