Skip to content
Snippets Groups Projects
Commit cba25d4f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix upgrade issue with CLISP from 2.27 to 2.31.

Why is this somehow not affecting other implementations???
parent 0066c48a
No related branches found
No related tags found
No related merge requests found
...@@ -83,7 +83,6 @@ Some constraints: ...@@ -83,7 +83,6 @@ Some constraints:
(when errorp (error "Can't find package ~A" pname))))) (when errorp (error "Can't find package ~A" pname)))))
(defun acall (name &rest args) (defun acall (name &rest args)
(apply (apply 'asym (if (consp name) name (list name))) args)) (apply (apply 'asym (if (consp name) name (list name))) args))
(defun ucall (name &rest args) (apply (asym name :uiop) args))
(defun asymval (name &optional package) (defun asymval (name &optional package)
(symbol-value (asym name package))) (symbol-value (asym name package)))
(defsetf asymval (name &optional package) (new-value) (defsetf asymval (name &optional package) (new-value)
...@@ -143,7 +142,7 @@ Some constraints: ...@@ -143,7 +142,7 @@ Some constraints:
(cond (cond
((equal x y) ((equal x y)
(format t "~S and~% ~S both evaluate to same path:~% ~S~%" qx qy x)) (format t "~S and~% ~S both evaluate to same path:~% ~S~%" qx qy x))
((ucall :pathname-equal x y) ((acall :pathname-equal x y)
(warn "These two expressions yield pathname-equal yet not equal path~%~ (warn "These two expressions yield pathname-equal yet not equal path~%~
the first expression ~S yields this:~% ~S~% ~S~% the first expression ~S yields this:~% ~S~% ~S~%
the other expression ~S yields that:~% ~S~% ~S~%" the other expression ~S yields that:~% ~S~% ~S~%"
...@@ -251,10 +250,10 @@ Some constraints: ...@@ -251,10 +250,10 @@ Some constraints:
(decode-universal-time stamp) (decode-universal-time stamp)
(unless in-filesystem (unless in-filesystem
(error "Y U NO use stamp cache?")) (error "Y U NO use stamp cache?"))
(ucall :run-program (acall :run-program
`("touch" "-t" ,(format nil "~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D" `("touch" "-t" ,(format nil "~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D"
year month day hr min sec) year month day hr min sec)
,(ucall :native-namestring file))) ,(acall :native-namestring file)))
(assert-equal (file-write-date file) stamp))))) (assert-equal (file-write-date file) stamp)))))
(defun mark-file-deleted (file) (defun mark-file-deleted (file)
(unless (asymval :*asdf-cache*) (error "Y U NO use asdf cache?")) (unless (asymval :*asdf-cache*) (error "Y U NO use asdf cache?"))
...@@ -319,7 +318,7 @@ is bound, write a message and exit on an error. If ...@@ -319,7 +318,7 @@ is bound, write a message and exit on an error. If
(break)) (break))
(t (t
(ignore-errors (ignore-errors
(ucall :print-condition-backtrace (acall :print-condition-backtrace
c :count 69 :stream *error-output*)) c :count 69 :stream *error-output*))
(leave-test "Script failed" 1)))))) (leave-test "Script failed" 1))))))
(funcall (or (asym :call-with-asdf-cache) 'funcall) thunk) (funcall (or (asym :call-with-asdf-cache) 'funcall) thunk)
...@@ -528,8 +527,7 @@ is bound, write a message and exit on an error. If ...@@ -528,8 +527,7 @@ is bound, write a message and exit on an error. If
(format t "Being a bit verbose~%") (format t "Being a bit verbose~%")
(when (asym :*asdf-verbose*) (setf (asymval :*asdf-verbose*) t)) (when (asym :*asdf-verbose*) (setf (asymval :*asdf-verbose*) t))
(when (asym :*verbose-out*) (setf (asymval :*verbose-out*) *standard-output*)) (when (asym :*verbose-out*) (setf (asymval :*verbose-out*) *standard-output*))
(when (and (asym :locate-system) (asym :pathname-directory-pathname) (when (and (asym :locate-system) (asym :pathname-directory-pathname) (asym :pathname-equal))
(asym :pathname-equal))
(format t "Comparing directories~%") (format t "Comparing directories~%")
(let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf))))) (let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf)))))
(assert-pathname-equal-helper ;; not always EQUAL (!) (assert-pathname-equal-helper ;; not always EQUAL (!)
......
...@@ -734,10 +734,7 @@ UNINTERN -- Remove symbols here from PACKAGE." ...@@ -734,10 +734,7 @@ UNINTERN -- Remove symbols here from PACKAGE."
(let ((ensure-form (let ((ensure-form
`(apply 'ensure-package ',(parse-define-package-form package clauses)))) `(apply 'ensure-package ',(parse-define-package-form package clauses))))
`(progn `(progn
#+clisp #+(or ecl gcl) (defpackage ,package (:use))
(eval-when (:compile-toplevel :load-toplevel :execute)
,ensure-form)
#+(or clisp ecl gcl) (defpackage ,package (:use))
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
,ensure-form)))) ,ensure-form))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment