From a5476212d73bfe7965d4ed05b429d96a99beb9cb Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Wed, 20 Nov 2013 14:50:30 -0500 Subject: [PATCH] ABCL: actual working fix to getcwd. Add a test. CMUCL: hush some warnings --- test/script-support.lisp | 2 +- test/test-utilities.script | 5 +++-- uiop/os.lisp | 5 +++-- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/test/script-support.lisp b/test/script-support.lisp index 22bb2157..fbee214e 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -36,7 +36,7 @@ Some constraints: (declaim (optimize (speed 2) (safety #-gcl 3 #+gcl 1) #-(or allegro gcl genera) (debug 3) #+(or cmu scl) (c::brevity 2))) (proclaim '(optimize (speed #-gcl 2 #+gcl 1) (safety #-gcl 3 #+gcl 1) #-(or allegro gcl genera) (debug 3) - #+(or cmu scl) (c::brevity 2))) + #+(or cmu scl) (c::brevity 2) #+(or cmu scl) (ext:inhibit-warnings 3))) (defvar *trace-symbols* `(;; If you want to trace some stuff while debugging ASDF, diff --git a/test/test-utilities.script b/test/test-utilities.script index 32243e4e..b2a5eb57 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -34,8 +34,7 @@ (assert (version-satisfies (find-system :test-asdf) "666")) (handler-case (version-satisfies (find-system :test-asdf) "666") (simple-warning (c) - (assert-equal (simple-condition-format-control c) - "Requested version ~S but ~S has no version")) + (assert (search "Requested version ~S but ~S has no version" (simple-condition-format-control c)))) (:no-error (x) (error "version-satisfies must warn when given component without version"))) (assert (version<= "2.0" (asdf-version))) @@ -234,6 +233,8 @@ (assert (not (base-string-p (strcat (basify "ab") #\c *last-char* (unbasify "d"))))) (assert (base-string-p (strcat (basify "ab") #\c #\d)))) +(assert-pathname-equal *test-directory* (getcwd)) + (assert-equal +crlf+ (map 'string 'code-char '(13 10))) (assert-equal +lf+ (map 'string 'code-char '(10))) (assert-equal +cr+ (map 'string 'code-char '(13))) diff --git a/uiop/os.lisp b/uiop/os.lisp index 1f0767d5..b97242bd 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -246,8 +246,9 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (defun getcwd () "Get the current working directory as per POSIX getcwd(3), as a pathname object" - (or #+abcl (parse-native-namestring - (java:jstatic "getProperty" "java.lang.System" "user.dir") :ensure-directory t) + (or #+abcl (symbol-call :asdf/filesystem :parse-native-namestring + (java:jstatic "getProperty" "java.lang.System" "user.dir") + :ensure-directory t) #+allegro (excl::current-directory) #+clisp (ext:default-directory) #+clozure (ccl:current-directory) -- GitLab