Commit 2c49dbc7 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.98: more portability fixes for GCL.

parent 27472551
......@@ -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*)
......
......@@ -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.
......
......@@ -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
......
......@@ -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))))
......
......@@ -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))))
......
......@@ -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
......
......@@ -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.
......
......@@ -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"))
......@@ -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*
......
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