Commit e51b3aca authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.48: make ASDF work somewhat on GCL<2.7. Further simplify traverse-action.

parent bdc9efaf
...@@ -11,6 +11,7 @@ lisps ?= ccl clisp sbcl ecl ecl_bytecodes cmucl abcl scl allegro lispworks alleg ...@@ -11,6 +11,7 @@ lisps ?= ccl clisp sbcl ecl ecl_bytecodes cmucl abcl scl allegro lispworks alleg
endif endif
export ASDF_OUTPUT_TRANSLATIONS := (:output-translations (t ("${sourceDirectory}/tmp/fasls" :implementation)) :ignore-inherited-configuration) export ASDF_OUTPUT_TRANSLATIONS := (:output-translations (t ("${sourceDirectory}/tmp/fasls" :implementation)) :ignore-inherited-configuration)
export CL_SOURCE_REGISTRY := (:source-registry (:tree "${sourceDirectory}") :ignore-inherited-configuration)
## MAJOR FAIL: gclcvs -- COMPILER BUG! Upstream fixed it, but upstream fails to compile. ## MAJOR FAIL: gclcvs -- COMPILER BUG! Upstream fixed it, but upstream fails to compile.
## NOT SUPPORTED BY OUR TESTS: cormancl genera lispworks-personal-edition mkcl rmcl. Manually tested once in a while. ## NOT SUPPORTED BY OUR TESTS: cormancl genera lispworks-personal-edition mkcl rmcl. Manually tested once in a while.
...@@ -29,6 +30,7 @@ SCL ?= scl ...@@ -29,6 +30,7 @@ SCL ?= scl
ALLEGRO ?= alisp ALLEGRO ?= alisp
ALLEGROMODERN ?= mlisp ALLEGROMODERN ?= mlisp
LISPWORKS ?= lispworks LISPWORKS ?= lispworks
GCL ?= gcl
# website, tag, install # website, tag, install
...@@ -98,6 +100,7 @@ test-upgrade: ...@@ -98,6 +100,7 @@ test-upgrade:
use_abcl () { li="${ABCL} --noinit --nosystem --noinform" ; ev="--eval" ; } ; \ use_abcl () { li="${ABCL} --noinit --nosystem --noinform" ; ev="--eval" ; } ; \
use_xcl () { li="${XCL} --noinit --nosystem --noinform" ; ev="--eval" ; } ; \ use_xcl () { li="${XCL} --noinit --nosystem --noinform" ; ev="--eval" ; } ; \
use_scl () { li="${SCL} -noinit" ; ev="-eval" ; } ; \ use_scl () { li="${SCL} -noinit" ; ev="-eval" ; } ; \
use_gcl () { li="GCL_ANSI=t ${GCL}" ; ev="-eval" ; } ; \
use_allegro () { li="${ALLEGRO} -q" ; ev="-e" ; } ; \ use_allegro () { li="${ALLEGRO} -q" ; ev="-e" ; } ; \
use_allegromodern () { li="${ALLEGROMODERN} -q" ; ev="-e" ; } ; \ use_allegromodern () { li="${ALLEGROMODERN} -q" ; ev="-e" ; } ; \
use_lispworks () { li="${LISPWORKS} -siteinit - -init -" ; ev="-eval" ; } ; \ use_lispworks () { li="${LISPWORKS} -siteinit - -init -" ; ev="-eval" ; } ; \
......
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.47" ;; to be automatically updated by bin/bump-revision :version "2.26.48" ;; to be automatically updated by bin/bump-revision
:depends-on () :depends-on ()
:components :components
((:file "asdf"))) ((:file "asdf")))
......
This diff is collapsed.
...@@ -56,6 +56,7 @@ ...@@ -56,6 +56,7 @@
(cons "asdf-src" path))) (cons "asdf-src" path)))
(bin-dir (&rest path) (append (or (pathname-directory root) (list :relative)) (bin-dir (&rest path) (append (or (pathname-directory root) (list :relative))
(cons "asdf-bin" path)))) (cons "asdf-bin" path))))
#-gcl<2.7
(setf (logical-pathname-translations "ASDFTEST") (setf (logical-pathname-translations "ASDFTEST")
`((,(format nil "**;*.~a" bin-type) `((,(format nil "**;*.~a" bin-type)
,(make-pathname :directory (bin-dir :wild-inferiors) ,(make-pathname :directory (bin-dir :wild-inferiors)
...@@ -316,7 +317,7 @@ ...@@ -316,7 +317,7 @@
(format t "output translations: ~S~%" (asdf::output-translations)) (format t "output translations: ~S~%" (asdf::output-translations))
#+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*))) #+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*)))
#-xcl ;;---*** pathnames are known to be massively broken on XCL #-(or xcl gcl<2.7) ;;---*** pathnames are known to be massively broken on XCL and GCL 2.6
(flet ((same (s1 s2 p1 p2) (flet ((same (s1 s2 p1 p2)
(unless (equal (namestring p1) (namestring p2)) (unless (equal (namestring p1) (namestring p2))
(describe p1) (describe p2) (describe p1) (describe p2)
...@@ -331,7 +332,7 @@ ...@@ -331,7 +332,7 @@
#-gcl #-gcl
(x (asdf::resolve-location '("/foo" "bar" :**/ "baz" #p"*.*") :directory nil :wilden t) #p"/foo/bar/**/baz/*.*"))) (x (asdf::resolve-location '("/foo" "bar" :**/ "baz" #p"*.*") :directory nil :wilden t) #p"/foo/bar/**/baz/*.*")))
#-xcl ;;---*** pathnames are known to be massively broken on XCL #-(or xcl gcl<2.7) ;;---*** pathnames are known to be massively broken on XCL and GCL 2.6
(or (test-component-pathnames :delete-host t :support-string-pathnames nil) (or (test-component-pathnames :delete-host t :support-string-pathnames nil)
(leave-lisp "test failed" 1))) (leave-lisp "test failed" 1)))
......
(in-package #:common-lisp-user) (cl:in-package :common-lisp-user)
(load (make-pathname :name "script-support" :defaults *load-pathname*)) (defun load-pathname ()
#-gcl *load-pathname*
#+gcl ;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011
(symbol-value
(find-symbol
"*LOAD-PATHNAME*"
(if (or (< system::*gcl-major-version* 2) ;; GCL 2.6 fails to fully compile ASDF at all
(and (= system::*gcl-major-version* 2)
(< system::*gcl-minor-version* 7)))
:system :cl))))
(in-package #:asdf-test) (load (make-pathname :name "script-support" :type "lisp" :defaults (load-pathname))
#+gcl :print #+gcl t)
(declaim (optimize (speed 2) (safety 3) #-allegro (debug 3) (in-package :asdf-test)
(declaim (optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)
#+(or cmu scl) (c::brevity 2))) #+(or cmu scl) (c::brevity 2)))
(proclaim '(optimize (speed 2) (safety 3) #-allegro (debug 3) (proclaim '(optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)
#+(or cmu scl) (c::brevity 2))) #+(or cmu scl) (c::brevity 2)))
(defun my-compile-file (&rest args) (apply 'compile-file args))
#+ecl (trace my-compile-file)
(cond (cond
((not (probe-file *asdf-lisp*)) ((not (probe-file *asdf-lisp*))
(leave-lisp "Testsuite failed: unable to find ASDF source" 3)) (leave-lisp "Testsuite failed: unable to find ASDF source" 3))
...@@ -20,27 +29,10 @@ ...@@ -20,27 +29,10 @@
(ignore-errors (load *asdf-fasl*))) (ignore-errors (load *asdf-fasl*)))
(leave-lisp "Reusing previously-compiled ASDF" 0)) (leave-lisp "Reusing previously-compiled ASDF" 0))
(t (t
#+clisp (load-asdf-lisp) (load-asdf-lisp)
(let ((tmp (make-pathname :name "asdf-tmp" :defaults *asdf-fasl*))) (let ((tmp (make-pathname :name "asdf-tmp" :defaults *asdf-fasl*)))
(ensure-directories-exist *asdf-fasl*)
(multiple-value-bind (result warnings-p errors-p) (multiple-value-bind (result warnings-p errors-p)
;; style warnings shouldn't abort the compilation [2010/02/03:rpg] (compile-asdf tmp)
(handler-bind (#+sbcl (sb-c::simple-compiler-note #'muffle-warning)
#+(and ecl (not ecl-bytecmp))
((or c:compiler-note c::compiler-debug-note
c:compiler-warning) ;; ECL emits more serious warnings than it should.
#'muffle-warning)
#+mkcl
((or compiler:compiler-note)
#'muffle-warning)
#-(or cmu scl)
(style-warning
#'(lambda (w)
;; escalate style-warnings to warnings - we don't want them.
(warn "Can you please fix ASDF to not emit style-warnings? Got a ~S:~%~A"
(type-of w) w)
(muffle-warning w))))
(my-compile-file *asdf-lisp* :output-file tmp :print t :verbose t))
(declare (ignore result)) (declare (ignore result))
(cond (cond
(errors-p (errors-p
......
...@@ -12,7 +12,7 @@ usage () { ...@@ -12,7 +12,7 @@ usage () {
echo " - quit with exit status >0 if an unhandled error occurs" echo " - quit with exit status >0 if an unhandled error occurs"
echo " you need to supply the .script in the second argument" echo " you need to supply the .script in the second argument"
echo " lisps include abcl, allegro, allegromodern, ccl (clozure)," echo " lisps include abcl, allegro, allegromodern, ccl (clozure),"
echo " clisp, cmucl, ecl, gclcvs, sbcl, and scl." echo " clisp, cmucl, ecl, gcl, gclcvs, sbcl, scl and xcl."
echo "OPTIONS:" echo "OPTIONS:"
echo " -d -- debug mode" echo " -d -- debug mode"
echo " -u -h -- show this message." echo " -u -h -- show this message."
...@@ -143,9 +143,14 @@ case "$lisp" in ...@@ -143,9 +143,14 @@ case "$lisp" in
command="${ECL:-ecl}" command="${ECL:-ecl}"
flags="-norc -eval (ext::install-bytecodes-compiler)" flags="-norc -eval (ext::install-bytecodes-compiler)"
eval="-eval" ;; eval="-eval" ;;
gcl)
export GCL_ANSI=t
command="${GCL:-gcl}"
flags="-batch"
eval="-eval" ;;
gclcvs) gclcvs)
export GCL_ANSI=t export GCL_ANSI=t
command="${GCL:-gclcvs}" command="${GCLCVS:-gclcvs}"
flags="-batch" flags="-batch"
eval="-eval" ;; eval="-eval" ;;
lispworks) lispworks)
......
...@@ -3,17 +3,17 @@ ...@@ -3,17 +3,17 @@
(:export (:export
#:*test-directory* #:*asdf-directory* #:*test-directory* #:*asdf-directory*
#:load-asdf #:load-asdf
#:register-directory #:asdf-load #:register-directory #:asdf-load
#:load-asdf-lisp #:compile-asdf #:load-asdf-fasl #:compile-load-asdf #:load-asdf-system #:load-asdf-lisp #:compile-asdf #:load-asdf-fasl #:compile-load-asdf #:load-asdf-system
#:quit-on-error #:test-asdf #:quit-on-error #:test-asdf
#:native-namestring #:native-namestring
#:exit-lisp #:leave-lisp #:exit-lisp #:leave-lisp
#:quietly)) #:quietly))
(in-package #:asdf-test) (in-package :asdf-test)
(declaim (optimize (speed 2) (safety 3) #-allegro (debug 3))) (declaim (optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)))
(proclaim '(optimize (speed 2) (safety 3) #-allegro (debug 3))) (proclaim '(optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)))
;;(format t "Evaluating asdf/test/script-support~%") ;;(format t "Evaluating asdf/test/script-support~%")
...@@ -21,11 +21,13 @@ ...@@ -21,11 +21,13 @@
;; We still want to work despite and host/device funkiness. ;; We still want to work despite and host/device funkiness.
(defparameter *test-directory* (defparameter *test-directory*
(make-pathname :name nil :type nil :version nil (make-pathname :name nil :type nil :version nil
:defaults (or *load-truename* *compile-file-truename*))) :defaults (or #+gcl (truename system:*load-pathname*)
*load-truename* *compile-file-truename*)))
(defparameter *asdf-directory* (defparameter *asdf-directory*
(merge-pathnames (truename
(make-pathname :directory '(:relative :back) :defaults *test-directory*) (merge-pathnames
*test-directory*)) (make-pathname :directory '(#-gcl :relative #-gcl :back #+gcl :parent) :defaults *test-directory*)
*test-directory*)))
(defparameter *asdf-lisp* (defparameter *asdf-lisp*
(make-pathname :name "asdf" :type "lisp" :defaults *asdf-directory*)) (make-pathname :name "asdf" :type "lisp" :defaults *asdf-directory*))
(defparameter *asdf-fasl* (defparameter *asdf-fasl*
...@@ -49,26 +51,37 @@ ...@@ -49,26 +51,37 @@
#+scl :scl #+scl :scl
#+xcl :xcl)))) #+xcl :xcl))))
(merge-pathnames (merge-pathnames
(make-pathname :directory `(:relative "tmp" "fasls" ,impl) (make-pathname :directory `(#-gcl :relative "tmp" "fasls" ,impl)
:defaults *asdf-directory*) :defaults *asdf-directory*)
*asdf-lisp*)))) *asdf-lisp*))))
(defun load-old-asdf (tag) (defun load-old-asdf (tag)
(let ((old-asdf (let ((old-asdf
(merge-pathnames (merge-pathnames
(make-pathname :directory `(:relative "tmp") (make-pathname :directory `(#-gcl :relative "tmp")
:name (format nil "asdf-~A" tag) :name (format nil "asdf-~A" tag)
:defaults *asdf-directory*) :defaults *asdf-directory*)
*asdf-lisp*))) *asdf-lisp*)))
(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning)) (handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning))
(load old-asdf)))) (load old-asdf))))
(defun configure-asdf ()
(funcall (find-symbol (string :initialize-source-registry) :asdf)
`(:source-registry :ignore-inherited-configuration))
(let ((registry (find-symbol (string :*central-registry*) :asdf)))
(set registry `(,*asdf-directory* ,*test-directory*))))
(defun load-asdf () (defun load-asdf ()
(load *asdf-fasl*) (load *asdf-fasl*)
(use-package :asdf :asdf-test) (use-package :asdf :asdf-test)
(import 'DBG :asdf) ;;(import 'DBG :asdf)
(configure-asdf)
(setf *package* (find-package :asdf-test))) (setf *package* (find-package :asdf-test)))
(defun hash-table->alist (table)
(loop :for key :being :the :hash-keys :of table :using (:hash-value value)
:collect (cons key value)))
(defun common-lisp-user::load-asdf () (defun common-lisp-user::load-asdf ()
(load-asdf)) (load-asdf))
...@@ -164,9 +177,31 @@ is bound, write a message and exit on an error. If ...@@ -164,9 +177,31 @@ is bound, write a message and exit on an error. If
(defun load-asdf-lisp () (defun load-asdf-lisp ()
(load *asdf-lisp*)) (load *asdf-lisp*))
(defun compile-asdf () #+(or gcl genera)
(unless (fboundp 'ensure-directories-exist)
(defun ensure-directories-exist (path)
#+genera (fs:create-directories-recursively (pathname path))
#+gcl (lisp:system (format nil "mkdir -p ~S" (namestring (make-pathname :name nil :type nil :defaults path))))))
(defun compile-asdf (&optional (output *asdf-fasl*))
(ensure-directories-exist *asdf-fasl*) (ensure-directories-exist *asdf-fasl*)
(compile-file *asdf-lisp* :output-file *asdf-fasl* :verbose t :print t)) ;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
(handler-bind (#+sbcl (sb-c::simple-compiler-note #'muffle-warning)
#+(and ecl (not ecl-bytecmp))
((or c:compiler-note c::compiler-debug-note
c:compiler-warning) ;; ECL emits more serious warnings than it should.
#'muffle-warning)
#+mkcl
((or compiler:compiler-note)
#'muffle-warning)
#-(or cmu scl)
(style-warning
#'(lambda (w)
;; escalate style-warnings to warnings - we don't want them.
(warn "Can you please fix ASDF to not emit style-warnings? Got a ~S:~%~A"
(type-of w) w)
(muffle-warning w))))
(compile-file *asdf-lisp* :output-file output #-gcl :verbose #-gcl t :print t)))
(defun load-asdf-fasl () (defun load-asdf-fasl ()
(load *asdf-fasl*)) (load *asdf-fasl*))
...@@ -220,6 +255,12 @@ outputs a tag plus a list of variable and their values, returns the last value" ...@@ -220,6 +255,12 @@ outputs a tag plus a list of variable and their values, returns the last value"
(pushnew :DBG *features*) (pushnew :DBG *features*)
#+gcl
(eval-when (:compile-toplevel :load-toplevel :execute)
(DBG :script-support *package* *test-directory* *asdf-directory* *asdf-lisp* *asdf-fasl*
))
#| #|
#+DBG (DBG :cas o c just-done base-stamp stamp-lookup out-files in-files file-op null-op op-time op-stamp dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in done-stamp (stamp<= latest-in earliest-out) (operation-done-p o c)) (DBG :cas o c just-done base-stamp stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c))
|# |#
...@@ -6,8 +6,7 @@ ...@@ -6,8 +6,7 @@
(quit-on-error (quit-on-error
(format t "~D~%" (asdf:asdf-version)) (format t "~D~%" (asdf:asdf-version))
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (load-system 'test-builtin-source-file-type-1 :verbose t)
(asdf:load-system 'test-builtin-source-file-type-1 :verbose t)
(assert (symbol-value (read-from-string "test-package::*test-tmp-cl*"))) (assert (symbol-value (read-from-string "test-package::*test-tmp-cl*")))
(assert-equal (assert-equal
(mapcar #'pathname-type (mapcar #'pathname-type
...@@ -24,5 +23,4 @@ ...@@ -24,5 +23,4 @@
'("lisp" "cl")) '("lisp" "cl"))
(delete-package :test-package) (delete-package :test-package)
(asdf:load-system 'test-builtin-source-file-type-4 :verbose t) (asdf:load-system 'test-builtin-source-file-type-4 :verbose t)
(assert (symbol-value (read-from-string "test-package::*test-tmp-cl*"))) (assert (symbol-value (read-from-string "test-package::*test-tmp-cl*"))))
)
...@@ -2,6 +2,7 @@ ...@@ -2,6 +2,7 @@
(load "script-support.lisp") (load "script-support.lisp")
(load-asdf) (load-asdf)
#-gcl<2.7
(setf (logical-pathname-translations "ASDF") (setf (logical-pathname-translations "ASDF")
#+(or allegro clisp) #+(or allegro clisp)
`(("**;*.*.*" ,(asdf::wilden *asdf-directory*))) `(("**;*.*.*" ,(asdf::wilden *asdf-directory*)))
...@@ -16,14 +17,14 @@ ...@@ -16,14 +17,14 @@
(format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd")) (format t "~S~%" (translate-logical-pathname "ASDF:test;test-force.asd"))
(format t "~S~%" (truename "ASDF:test;test-force.asd")) (format t "~S~%" (truename "ASDF:test;test-force.asd"))
#-xcl #-(or xcl gcl<2.7)
(progn (progn
(format t "Test logical pathnames in central registry~%") (format t "Test logical pathnames in central registry~%")
(setf *central-registry* '(#p"ASDF:test;")) (setf *central-registry* '(#p"ASDF:test;"))
(initialize-source-registry '(:source-registry :ignore-inherited-configuration)) (initialize-source-registry '(:source-registry :ignore-inherited-configuration))
(load-system :test-logical-pathname :force t)) (load-system :test-logical-pathname :force t))
#-xcl #-(or xcl gcl<2.7)
(progn (progn
(format t "Test logical pathnames in source-registry, non-recursive~%") (format t "Test logical pathnames in source-registry, non-recursive~%")
(clear-system :test-logical-pathname) (clear-system :test-logical-pathname)
...@@ -32,7 +33,7 @@ ...@@ -32,7 +33,7 @@
'(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration)) '(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration))
(load-system :test-logical-pathname :force t)) (load-system :test-logical-pathname :force t))
#-xcl #-(or xcl gcl<2.7)
(progn (progn
(format t "Test logical pathnames in source-registry, recursive~%") (format t "Test logical pathnames in source-registry, recursive~%")
(clear-system :test-logical-pathname) (clear-system :test-logical-pathname)
......
(in-package #:asdf-test) (in-package :asdf-test)
;;; -*- Mode: common-lisp; Syntax: Common-Lisp; -*- ;;; -*- Mode: common-lisp; Syntax: Common-Lisp; -*-
(in-package #:common-lisp-user) (in-package :common-lisp-user)
(defpackage #:test-nested-components.system (defpackage #:test-nested-components.system
(:use #:common-lisp #:asdf)) (:use #:common-lisp #:asdf))
(in-package #:test-nested-components.system) (in-package :test-nested-components.system)
(defsystem test-nested-components-a (defsystem test-nested-components-a
:components :components
......
...@@ -4,35 +4,27 @@ ...@@ -4,35 +4,27 @@
(load "script-support.lisp") (load "script-support.lisp")
(load-asdf) (load-asdf)
;(trace asdf::find-component)
;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate)
;#+allegro
;(trace excl.osi:command-output)
(defvar *caught-error* nil) (defvar *caught-error* nil)
(quit-on-error (quit-on-error
;;(format t "trlc1 1~%") (DBG "trlc1 1")
(when (probe-file "try-reloading-dependency.asd") (asdf::delete-file-if-exists "try-reloading-dependency.asd")
(asdf:run-shell-command "rm -f ~A"
(namestring "try-reloading-dependency.asd")))
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(setf asdf::*defined-systems* (asdf::make-defined-systems-table)) (setf asdf::*defined-systems* (asdf::make-defined-systems-table))
;;(format t "trlc1 2~%") (DBG "trlc1 2")
(handler-bind ((error (lambda (c) (handler-bind ((error (lambda (c)
(format t "~&Caught error ~s" c) (format t "~&Caught error ~s" c)
(setf *caught-error* t) (setf *caught-error* t)
(asdf:run-shell-command (asdf:run-shell-command
"cp try-reloading-dependency.hidden try-reloading-dependency.asd") "cp try-reloading-dependency.hidden try-reloading-dependency.asd")
;;(format t "trlc1 5~%") (DBG "trlc1 5")
(multiple-value-bind (name mode) (multiple-value-bind (name mode)
(find-symbol (symbol-name 'retry) :asdf) (find-symbol (symbol-name 'retry) :asdf)
(DBG "trlc1 6" name mode)
(assert (eq mode :external) nil "Mode of ~s was not external" name) (assert (eq mode :external) nil "Mode of ~s was not external" name)
;;(format t "trlc1 6~%")
(let ((restart (find-restart name c))) (let ((restart (find-restart name c)))
;;(format t "trlc1 7~%") (DBG "trlc1 7" restart)
(assert restart) (assert restart)
(format t "~&restart: ~S~&" restart)
(when restart (invoke-restart restart))))))) (when restart (invoke-restart restart)))))))
;;(format t "trlc1 3~%") (DBG "trlc1 3")
(asdf:oos 'asdf:load-op 'try-reloading-1)) (asdf:oos 'asdf:load-op 'try-reloading-1))
;;(format t "trlc1 4~%") (DBG "trlc1 4")
(assert *caught-error*)) (assert *caught-error*))
;; part of the test-module-pathnames test ;; part of the test-module-pathnames test
(in-package #:test-package) (in-package :test-package)
(defparameter *test-tmp-cl* t) (defparameter *test-tmp-cl* t)
......
;; part of the test-module-pathnames test ;; part of the test-module-pathnames test
(in-package #:test-package) (in-package :test-package)
(defparameter *test-tmp-cl* t) (defparameter *test-tmp-cl* t)
......
...@@ -10,9 +10,9 @@ ...@@ -10,9 +10,9 @@
(assert (assert
(every #'directory-pathname-p (every #'directory-pathname-p
(list (list
(make-pathname :name nil :type "" :directory '(:absolute "tmp")) (make-pathname* :name nil :type "" :directory '(:absolute "tmp"))
(make-pathname :name "" :directory '(:absolute "tmp")) (make-pathname* :name "" :directory '(:absolute "tmp"))
(make-pathname :type "" :directory '(:absolute "tmp")) (make-pathname* :type "" :directory '(:absolute "tmp"))
;; CLHS 19.2.2.2.3 says we can't portably specify :unspecific here, ;; CLHS 19.2.2.2.3 says we can't portably specify :unspecific here,
;; and some implementations will enforce it. ;; and some implementations will enforce it.
;; (make-pathname :type :unspecific :directory '(:absolute "tmp")) ;; (make-pathname :type :unspecific :directory '(:absolute "tmp"))
...@@ -22,11 +22,11 @@ ...@@ -22,11 +22,11 @@
(assert (assert
(every (complement #'directory-pathname-p) (every (complement #'directory-pathname-p)
(list (list
(make-pathname :name "foo" :type nil :directory '(:absolute "tmp")) (make-pathname* :name "foo" :type nil :directory '(:absolute "tmp"))
(make-pathname :name nil :type "bar" :directory '(:absolute "tmp"))))) (make-pathname* :name nil :type "bar" :directory '(:absolute "tmp")))))
;; These are funky and non portable. Omit from tests. ;; These are funky and non portable. Omit from tests.
;; (make-pathname :name "." :type nil :directory '(:absolute "tmp")) ;; (make-pathname* :name "." :type nil :directory '(:absolute "tmp"))
;; (make-pathname :name "." :type "" :directory '(:absolute "tmp")) ;; (make-pathname* :name "." :type "" :directory '(:absolute "tmp"))
(assert (equal (multiple-value-list (component-name-to-pathname-components "" :force-directory t)) (assert (equal (multiple-value-list (component-name-to-pathname-components "" :force-directory t))
'(:relative nil nil))) '(:relative nil nil)))
(assert (equal (multiple-value-list (component-name-to-pathname-components "" :force-directory nil)) (assert (equal (multiple-value-list (component-name-to-pathname-components "" :force-directory nil))
......
(in-package #:asdf-test) (in-package :asdf-test)
(setf *test6* :yes) (setf *test6* :yes)
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
(load "script-support.lisp") (load "script-support.lisp")
(load-asdf) (load-asdf)
(in-package #:asdf-test) (in-package :asdf-test)
(quit-on-error (quit-on-error
(setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf:*central-registry* '(*default-pathname-defaults*))
......
(in-package #:asdf-test) (in-package :asdf-test)
#+clisp (eval-when (:compile-toplevel) (fmakunbound 'try-recompiling-1)) #+clisp (eval-when (:compile-toplevel) (fmakunbound 'try-recompiling-1))
......
...@@ -2,6 +2,5 @@ ...@@ -2,6 +2,5 @@
(load "script-support.lisp") (load "script-support.lisp")
(load-asdf) (load-asdf)
(quit-on-error (quit-on-error
(load "../wild-modules.lisp") (load (asdf:system-relative-pathname :asdf "wild-modules.lisp"))
(setf *central-registry* '(*default-pathname-defaults*))
(load-system :wild-module)) (load-system :wild-module))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment