Fix importing on SBCL by using :CASE :LOCAL instead of :COMMON

compiler/compiler.lisp

@@ -1348,7 +1348,7 @@ LOCALS shares share tail structure with input arg locals."
   `(let ((*module-namespace* nil)) ;; hack
      (values ,@(loop for (mod-name-as-list bind-name) in items
                    for top-name = (car mod-name-as-list)
-                   collect `(let* ((args (list :within-mod-path ',(careful-derive-pathname *compile-file-truename* nil)
+                   collect `(let* ((args (list :within-mod-path ,*compile-file-truename*
                                                :within-mod-name ',*current-module-name*))
                                    (top-module (apply #'py-import '(,top-name) args))
                                    (deep-module ,(if (cdr mod-name-as-list)
@@ -1363,7 +1363,7 @@ LOCALS shares share tail structure with input arg locals."
 
 (defmacro [import-from-stmt] (mod-name-as-list items)
   `(let* ((*module-namespace* nil) ;; hack
-          (args (list :within-mod-path ',(careful-derive-pathname *compile-file-truename* nil)
+          (args (list :within-mod-path ,*compile-file-truename*
                       :within-mod-name ',*current-module-name*))
           (m (apply #'py-import '(,(car mod-name-as-list)) args)))
      (declare (ignorable m)) ;; Ensure topleve module is imported relative to current mod
@@ -1508,9 +1508,9 @@ LOCALS shares share tail structure with input arg locals."
     (setf *habitat* (make-habitat))))
 ||#
 
-(defun careful-derive-pathname (pathname default)
+(defun careful-derive-pathname (pathname default &rest options)
   (if pathname
-      (derive-pathname pathname)
+      (apply #'derive-pathname pathname options)
     default))
 
 (defmacro with-module-toplevel-context (() &body body)
@@ -1624,8 +1624,8 @@ LOCALS shares share tail structure with input arg locals."
            #+clpython-source-level-debugging
            ,(create-python-source-location-table-pydecl suite)
 
-           (module-init :src-pathname ,(careful-derive-pathname *compile-file-truename* nil)
-                        :bin-pathname (load-time-value (careful-derive-pathname *load-truename* #P"__main__"))
+           (module-init :src-pathname ,*compile-file-truename*
+                        :bin-pathname (load-time-value (careful-derive-pathname *load-truename* #P"__main__" :case #+sbcl :local #-sbcl :common))
                         :current-module-name ,*current-module-name*
                         :defun-wrappers ',(mapcar #'second defun-wrappers)
                         :source ,(when *compile-file-truename*

runtime/import.lisp

@@ -25,17 +25,30 @@
 ;; Pathname handling is as suggested by Kent Pitman on comp.lang.lisp
 ;; <sfwzo21um0k.fsf@shell01.TheWorld.com>
 
-(defun %get-py-file-name (kind modname filepath type)
+(defun %get-py-file-name (kind modname filepath type &key (case :common))
+  #+sbcl
+  (when (member type *py-source-file-types*)
+    ;; For SBCL don't use :COMMON as that gives case problems; use :LOCAL instead.
+    ;; https://github.com/metawilm/cl-python/issues/1
+    ;; https://github.com/metawilm/cl-python/pull/20
+    ;; https://bugs.launchpad.net/sbcl/+bug/695486
+    (setf case :local
+          type (string-downcase type)))
+
   (ecase kind
     (:module (derive-pathname filepath
-                              :name (pathname-name modname :case :common)
-                              :type type))
+                              :name (pathname-name modname :case case)
+                              :type type
+                              :case case))
     (:package (merge-pathnames
-               (make-pathname :directory `(:relative ,(pathname-name modname :case :common))
-                              :case :common)
+               (make-pathname :directory `(:relative ,(pathname-name modname :case case))
+                              :case case)
                (derive-pathname filepath
                                 :type type
-                                :name *package-indicator-filename*)))))
+                                :name
+                                #+sbcl (string-downcase *package-indicator-filename*)
+                                #-sbcl *package-indicator-filename*
+                                :case case)))))
 
 (defun source-file-names (kind modname filepath)
   (check-type modname string)

util/utils.lisp

@@ -326,14 +326,15 @@ See function ALIST-VS-HT.")
       always (loop for slot in (closer-mop:class-slots class)
                  thereis (member initarg (closer-mop:slot-definition-initargs slot)))))
 
-(defun derive-pathname (pathname &key (type      (pathname-type pathname      :case :common))
-                                      (name      (pathname-name pathname      :case :common))
-                                      (host      (pathname-host pathname      :case :common))
-                                      (device    (pathname-device pathname    :case :common))
-                                      (directory (pathname-directory pathname :case :common))
+(defun derive-pathname (pathname &key (case :common)
+                                      (type      (pathname-type pathname      :case case))
+                                      (name      (pathname-name pathname      :case case))
+                                      (host      (pathname-host pathname      :case case))
+                                      (device    (pathname-device pathname    :case case))
+                                      (directory (pathname-directory pathname :case case))
                                       (version   (pathname-version pathname)))
   (make-pathname :type type :name name :host host :device device
-                 :directory directory :version version :case :common))
+                 :directory directory :version version :case case))
 
 (defun ensure-path-is-directory (path)
   (let* ((truename (truename path))