Permalink
Browse files

SCL compatibility fixes.

  • Loading branch information...
1 parent 4d79222 commit e249362b41c321eb74b919be2bfc88db616cc27a @sionescu sionescu committed Oct 18, 2008
Showing with 30 additions and 15 deletions.
  1. +1 −1 posix/early.lisp
  2. +17 −4 src/fd-streams.lisp
  3. +1 −1 src/osicat-sys.lisp
  4. +3 −1 src/osicat.lisp
  5. +7 −7 tests/osicat.lisp
  6. +1 −1 tests/posix.lisp
View
@@ -114,7 +114,7 @@
;;; FIXME: undocumented in cffi-grovel.
(defun make-from-pointer-function-name (type-name)
- (format-symbol t "MAKE-~a-FROM-POINTER" type-name))
+ (format-symbol t "~A-~A-~A-~A" '#:make type-name '#:from '#:pointer))
(define-parse-method errno-wrapper
(base-type &key error-predicate (return-filter 'identity)
View
@@ -32,25 +32,38 @@
;;;
;;; Also, this is unused for now.
-#+(or sbcl cmu openmcl)
+#+(or sbcl cmu openmcl scl)
(pushnew :osicat-fd-streams *features*)
#+sbcl
-(defun make-fd-stream (fd &key direction element-type external-format)
+(defun make-fd-stream (fd &key direction element-type external-format
+ pathname file)
+ (declare (ignore pathname file))
(let ((in-p (member direction '(:io :input)))
(out-p (member direction '(:io :output))))
(sb-sys:make-fd-stream fd :input in-p :output out-p
:element-type element-type
:external-format external-format)))
#+cmu
-(defun make-fd-stream (fd &key direction element-type external-format)
- (declare (ignore external-format))
+(defun make-fd-stream (fd &key direction element-type external-format
+ pathname file)
+ (declare (ignore external-format pathname file))
(let ((in-p (member direction '(:io :input)))
(out-p (member direction '(:io :output))))
(sys:make-fd-stream fd :input in-p :output out-p
:element-type element-type)))
+#+scl
+(defun make-fd-stream (fd &key direction element-type external-format
+ pathname file)
+ (let ((in-p (member direction '(:io :input)))
+ (out-p (member direction '(:io :output))))
+ (sys:make-fd-stream fd :input in-p :output out-p
+ :element-type element-type
+ :external-format external-format
+ :pathname pathname :file file)))
+
;;; KLUDGE: This is kind of evil, because MAKE-FD-STREAM isn't
;;; exported from CCL in OpenMCL. However, it seems to have been
;;; around for a while, and the developers have said that they don't
View
@@ -118,7 +118,7 @@
(defmacro define-designator (name cffi-type &body type-clauses)
(let ((type `(quote (or ,@(mapcar #'car type-clauses))))
- (ctype (alexandria:format-symbol t "~A-DESIGNATOR" name)))
+ (ctype (alexandria:format-symbol t "~A-~A" name '#:designator)))
`(progn
(deftype ,name () ,type)
(defun ,name (,name)
View
@@ -273,7 +273,9 @@ PATHSPEC exists and is a symlink pointing to an existent file."
(nix:unlink path))
(make-fd-stream fd :direction :io
:element-type element-type
- :external-format external-format))
+ :external-format external-format
+ :pathname (pathname path)
+ :file path))
(nix:posix-error ()
(error 'file-error :pathname filename))))
View
@@ -69,7 +69,7 @@
(deftest environment.2
(unwind-protect
(progn
- (setf (environment-variable 'test-variable) "TEST-VALUE")
+ (setf (environment-variable "TEST-VARIABLE") "TEST-VALUE")
(assoc "TEST-VARIABLE" (environment) :test #'equal))
(makunbound-environment-variable 'test-variable))
("TEST-VARIABLE" . "TEST-VALUE"))
@@ -88,16 +88,16 @@
(deftest environment-variable.2
(unwind-protect
(progn
- (setf (environment-variable 'test-variable) 'test-value)
- (environment-variable 'test-variable))
- (makunbound-environment-variable 'test-variable))
+ (setf (environment-variable "TEST-VARIABLE") "TEST-VALUE")
+ (environment-variable "TEST-VARIABLE"))
+ (makunbound-environment-variable "TEST-VARIABLE"))
"TEST-VALUE")
(deftest environment-variable.3
(unwind-protect
(progn
(setf (environment-variable "test-variable") "test-value")
- (environment-variable 'test-variable))
+ (environment-variable "TEST-VARIABLE"))
(makunbound-environment-variable "test-variable"))
nil)
@@ -188,8 +188,8 @@
(unwind-protect
(progn
(make-link link :target file)
- (equal (namestring (merge-pathnames file *test-directory*))
- (namestring (read-link link))))
+ (equal (native-namestring (merge-pathnames file *test-directory*))
+ (native-namestring (read-link link))))
(osicat-posix:unlink link)
(osicat-posix:unlink file)))
t)
View
@@ -366,7 +366,7 @@
;; if this test fails, it will probably be with
;; "System call error 2 (No such file or directory)"
(let ((*default-pathname-defaults* *test-directory*))
- (handler-case (nix:unlink (car (directory "*.txt")))
+ (handler-case (nix:unlink (car (directory (merge-pathnames "*.txt"))))
#+windows (nix:eacces () 0))))
0)

0 comments on commit e249362

Please sign in to comment.