diff --git a/compatibility.lisp b/compatibility.lisp index c7304306dd2a4006351caa2790b99bb1ff3d3277..56a8cfc3f0d0339342f30e88aaa46954d268d16c 100644 --- a/compatibility.lisp +++ b/compatibility.lisp @@ -13,6 +13,7 @@ #:logical-pathname #:translate-logical-pathname #:make-broadcast-stream #:file-namestring) #+ecl (:export #:use-ecl-byte-compiler-p) + ;;#+gcl (:shadow #:type-of #:with-standard-io-syntax) ; causes errors when loading fasl(!) #+genera (:import-from :scl #:boolean) #+genera (:export #:boolean #:ensure-directories-exist) #+mcl (:export #:probe-posix #:current-user-homedir-pathname) @@ -52,9 +53,9 @@ (when (or (< system::*gcl-major-version* 2) ;; GCL 2.6 lacks output-translations and more. (and (= system::*gcl-major-version* 2) (< system::*gcl-minor-version* 7))) - (format t "Detected an old GCL 2.6. Only limited functionality available.~%") (shadow 'type-of :asdf/compatibility) - (export 'with-standard-io-syntax) + ;;(shadow 'with-standard-io-syntax :asdf/compatibility) + ;;(format t "Detected an old GCL 2.6. Only limited functionality available.~%") (pushnew 'ignorable pcl::*variable-declarations-without-argument*) (pushnew :gcl<2.7 *features*)) (unless (member :ansi-cl *features*) diff --git a/footer.lisp b/footer.lisp index 68b116286681e0dba16279059b73fa09b3bd5357..41cb7e124c5f24c1bdf15ff0ffda3ab2911238d7 100644 --- a/footer.lisp +++ b/footer.lisp @@ -7,7 +7,7 @@ :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/operate :asdf/bundle :asdf/concatenate-source :asdf/output-translations :asdf/source-registry - :asdf/backward-internals :asdf/defsystem :asdf/backward-interface :asdf/interface)) + :asdf/backward-internals :asdf/defsystem :asdf/backward-interface)) (in-package :asdf/footer) ;;;; Hook ASDF into the implementation's REQUIRE and other entry points. diff --git a/os.lisp b/os.lisp index d3e80e0152524e17021af0c02e2b3c381e9770d9..59d731ff9aea344904661a0d67d888ab873fdba9 100644 --- a/os.lisp +++ b/os.lisp @@ -281,8 +281,7 @@ then returning the non-empty string value of the variable" (defun setup-temporary-directory () (setf *temporary-directory* (default-temporary-directory)) ;; basic lack fixed after gcl 2.7.0-61, but ending / required still on 2.7.0-64.1 - #+gcl (setf system::*tmp-dir* *temporary-directory*)) - + #+(and gcl (not gcl<2.7)) (setf system::*tmp-dir* *temporary-directory*)) (defun* call-with-temporary-file (thunk &key diff --git a/package.lisp b/package.lisp index f8b0839a6fd408a497bf8dd0ed2f639bc4a84342..43bbea2a3a66a2c1a0674e945d8927fb8e43ae39 100644 --- a/package.lisp +++ b/package.lisp @@ -571,10 +571,11 @@ or when loading the package is optional." (defmacro define-package (package &rest clauses) `(eval-when (:compile-toplevel :load-toplevel :execute) #+(or ecl gcl) (defpackage ,package (:use)) - #+clisp (macrolet ((foo () - (apply 'ensure-package ',(parse-define-package-form package clauses)) - (package-definition-form ',package :nicknamesp nil))) - (foo)) + #+clisp + (macrolet ((foo () + (apply 'ensure-package ',(parse-define-package-form package clauses)) + (package-definition-form ',package :nicknamesp nil))) + (foo)) (apply 'ensure-package ',(parse-define-package-form package clauses)))) diff --git a/run-program.lisp b/run-program.lisp index 4f8d7d1a607f60267f26d6b494bc329af2f22856..8cbb7a84376642269e86fd995e01c31d659b1c9e 100644 --- a/run-program.lisp +++ b/run-program.lisp @@ -173,11 +173,9 @@ by /bin/sh in POSIX" (declare (ignorable stream element-type)) (cond #+(or gcl<2.7 genera) - ((functionp x) - (funcall x stream)) + ((functionp x) (funcall x stream)) #+(or gcl<2.7 genera) - ((output-stream-p x) - (copy-stream-to-stream stream x :element-type element-type)) + ((output-stream-p x) (copy-stream-to-stream stream x :element-type element-type)) (t (error "Invalid ~S destination ~S" 'slurp-input-stream x)))) diff --git a/stream.lisp b/stream.lisp index 3a75d5dcd0618f8ebd1e318a55ae493eb20809af..ec94de9d51c0b5d283cda463dfae2db9ef3989a2 100644 --- a/stream.lisp +++ b/stream.lisp @@ -4,6 +4,7 @@ (asdf/package:define-package :asdf/stream (:recycle :asdf/stream) (:use :cl :asdf/package :asdf/compatibility :asdf/utility :asdf/pathname) + #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:with-standard-io-syntax) (:export #:*default-stream-element-type* #:*stderr* #:setup-stderr #:with-safe-io-syntax #:call-with-safe-io-syntax diff --git a/test/script-support.lisp b/test/script-support.lisp index 0423cb328ae9041350c8c09f6ebc0320bd09f482..6ba9ff3bfff8cb073cabcb9a5847a5694216fefa 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -39,6 +39,13 @@ Some constraints: (defvar *debug-asdf* nil) (defvar *quit-when-done* t) +(defun verbose (&optional (verbose t)) + (loop :for v :in '(*load-verbose* *compile-verbose* + *load-print* *compile-print*) + :do (setf (symbol-value v) verbose))) + +(verbose nil) + ;;; Minimal compatibility layer (eval-when (:compile-toplevel :load-toplevel :execute) #+allegro @@ -148,10 +155,11 @@ Some constraints: (defun touch-file (file &key (offset 0) timestamp) (let ((timestamp (or timestamp (+ offset (get-universal-time))))) - (multiple-value-bind (sec min hr day month year) (decode-universal-time timestamp) + (multiple-value-bind (sec min hr day month year) (decode-universal-time timestamp #+gcl<2.7 -5) (acall :run-shell-command "touch -t ~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D ~S" - year month day hr min sec (namestring file))))) + year month day hr min sec (namestring file)) + (assert-equal (file-write-date file) timestamp)))) (defun hash-table->alist (table) (loop :for key :being :the :hash-keys :of table :using (:hash-value value) @@ -229,7 +237,7 @@ is bound, write a message and exit on an error. If (funcall thunk))) (defun load-asdf-lisp (&optional tag) - (quietly (load (asdf-lisp tag)))) + (quietly (load (asdf-lisp tag) :verbose *load-verbose* :print *load-print*))) (defun load-asdf-fasl (&optional tag) (quietly (load (asdf-fasl tag)))) @@ -373,13 +381,15 @@ is bound, write a message and exit on an error. If (setf *package* (find-package :asdf-test))) ;; Actual scripts rely on this function: -(defun common-lisp-user::load-asdf () (load-asdf)) +(defun common-lisp-user::load-asdf () (load-asdf)) ;; These are shorthands for interactive debugging of test scripts: (!a common-lisp-user::debug-asdf debug-asdf da debug-asdf common-lisp-user::da debug-asdf - la load-asdf common-lisp-user::la load-asdf) + la load-asdf common-lisp-user::la load-asdf + ll load-asdf-lisp + v verbose) #| For the record, the following form is sometimes useful to insert in asdf/plan:compute-action-stamp to find out what's happening. diff --git a/test/test-logical-pathname.script b/test/test-logical-pathname.script index 156c06ddbf03a9a8f2ce466e864f8c284a555c48..fe3bb30443b4133113990df0b1b3d5a0af3be759 100644 --- a/test/test-logical-pathname.script +++ b/test/test-logical-pathname.script @@ -17,38 +17,39 @@ :wilden t)))) (with-test () - (DBG :logical - (logical-pathname-translations "ASDF") - (translate-logical-pathname "ASDF:test;test-force.asd") - (truename "ASDF:test;test-force.asd")) + #-gcl<2.7 + (DBG :logical + (logical-pathname-translations "ASDF") + (translate-logical-pathname "ASDF:test;test-force.asd") + (truename "ASDF:test;test-force.asd")) - #-(or xcl gcl<2.7) - (progn - (DBG "Test logical pathnames in central registry") - (setf *central-registry* '(#p"ASDF:test;")) - (initialize-source-registry '(:source-registry :ignore-inherited-configuration)) - (DBG "loading" (oos 'load-op :test-logical-pathname :force t))) + #-(or xcl gcl<2.7) + (progn + (DBG "Test logical pathnames in central registry") + (setf *central-registry* '(#p"ASDF:test;")) + (initialize-source-registry '(:source-registry :ignore-inherited-configuration)) + (DBG "loading" (oos 'load-op :test-logical-pathname :force t))) - #-(or xcl gcl<2.7) - (progn - (DBG "Test logical pathnames in source-registry, non-recursive") - (clear-system :test-logical-pathname) - (setf *central-registry* '()) - (initialize-source-registry - '(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration)) - (load-system :test-logical-pathname :force t :verbose t)) + #-(or xcl gcl<2.7) + (progn + (DBG "Test logical pathnames in source-registry, non-recursive") + (clear-system :test-logical-pathname) + (setf *central-registry* '()) + (initialize-source-registry + '(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration)) + (load-system :test-logical-pathname :force t :verbose t)) - #-(or xcl gcl<2.7) - (progn - (DBG "Test logical pathnames in source-registry, recursive") - (clear-system :test-logical-pathname) - (setf *central-registry* '()) - (initialize-source-registry - ;; Bug: Allegro Express 8.2 and 9.0 incorrectly read #p"ASDF:" as relative. - ;; other bug: around 2.26.xx, CLISP borks badly if this is ASDF: - ;; and it tries to load ASDF from a logical-pathname. - '(:source-registry (:tree #p"ASDF:test;") - :ignore-inherited-configuration)) - (load-system :test-logical-pathname :force t)) + #-(or xcl gcl<2.7) + (progn + (DBG "Test logical pathnames in source-registry, recursive") + (clear-system :test-logical-pathname) + (setf *central-registry* '()) + (initialize-source-registry + ;; Bug: Allegro Express 8.2 and 9.0 incorrectly read #p"ASDF:" as relative. + ;; other bug: around 2.26.xx, CLISP borks badly if this is ASDF: + ;; and it tries to load ASDF from a logical-pathname. + '(:source-registry (:tree #p"ASDF:test;") + :ignore-inherited-configuration)) + (load-system :test-logical-pathname :force t)) - (DBG "Done")) + (DBG "Done")) diff --git a/utility.lisp b/utility.lisp index 4a2621c37072a170023e2c5877009d4886f24b00..c0512481b28dbb151b0ea34e508b698b369c112c 100644 --- a/utility.lisp +++ b/utility.lisp @@ -4,6 +4,7 @@ (asdf/package:define-package :asdf/utility (:recycle :asdf/utility :asdf) (:use :common-lisp :asdf/package :asdf/compatibility) + #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:with-standard-io-syntax) (:export ;; magic helper to define debugging functions: #:asdf-debug #:load-asdf-debug-utility #:*asdf-debug-utility*