diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script
index c6a679187aff2173265764b2a2f151dfbfe042cd..aeab9fd0bb159fa3cebfd477ed594e13f1f36e7f 100644
--- a/test/asdf-pathname-test.script
+++ b/test/asdf-pathname-test.script
@@ -17,7 +17,8 @@
 ;;;   '/test/{system1,system2}/'
 ;;; any failure is recorded as a transcript entry which indicates
 ;;;   ( ( system-pathname module-pathname file-pathname ) missing-pathnames )
-;;; where missing pathnames is a list of the component-pathname values which failed to designate an intended file.
+;;; where missing pathnames is a list of the component-pathname values
+;;; which failed to designate an intended file.
 ;;; If there, if the pathname is logical, both the logical and physical pathname appears.
 ;;; where NIL appears, the probe-file succeeded.
 ;;;
@@ -297,7 +298,7 @@
                                                                    ;; :static-file "module2/static-file.type"
                    collect (make-pathname :directory directory :name "static-file" :type "type"
                                           :defaults root)
-                   
+
                                      ;;; source file pathname variations
                    collect (make-pathname :directory (append directory '("module2")) :name  "untyped-file" :type nil
                                           :defaults root)
@@ -379,7 +380,7 @@
                 :files files
                 :modules modules
                 :systems systems)))))
-             
+
            (when delete-host
              (setf (logical-pathname-translations "ASDFTEST") nil))
            (clear-system "test-system")))
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 4ca98db63ba445cb82042ea1c6f16133ff19c588..e90e93189ae4ca75636d662b68b9fd85d6125b03 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -134,7 +134,7 @@
     #+sbcl uiop/lisp-build:sb-grovel-unknown-constant-condition
     ;; on some implementations only
     asdf/bundle:bundle-system
-    asdf/bundle:register-pre-built-system 
+    asdf/bundle:register-pre-built-system
     asdf/bundle:static-library
     uiop/os:parse-file-location-info
     uiop/os:parse-windows-shortcut
@@ -211,14 +211,16 @@
 (defun unbasify (s) (coerce s '(array character (*)))) ; on ECL, literals are base strings (!)
 
 #+non-base-chars-exist-p
-(progn
+(let* ((limit-char (code-char (1- char-code-limit)))
+       (limit-string (string limit-char)))
+  (assert (not (base-string-p limit-string)))
   (assert (not (base-string-p (make-string 10 :element-type 'character))))
   (assert (not (base-string-p (unbasify "abc"))))
   (assert (base-string-p (basify "abc")))
-  (assert (not (base-string-p (strcat "a" nil #\b (unbasify "cd")))))
+  (assert (base-string-p (strcat "a" nil #\b (unbasify "cd"))))
   (assert (base-string-p (reduce/strcat (mapcar 'basify '("a" "b" nil "cd")))))
   (assert (base-string-p (strcat (basify "ab") (basify "cd"))))
-  (assert (not (base-string-p (strcat (basify "ab") #\c (unbasify "d")))))
+  (assert (not (base-string-p (strcat (basify "ab") #\c limit-char (unbasify "d")))))
   (assert (base-string-p (strcat (basify "ab") #\c #\d))))
 
 (assert-equal +crlf+ (map 'string 'code-char '(13 10)))
@@ -239,5 +241,5 @@
   (ts "c" +crlf+ (strcat ccr +lf+))
   (ts (strcat acrlf "b") +lf+ (strcat acrlf blf)))
 
-(with-temporary-file (:stream s :direction :io :element-type 'character :prefix "LEP")
+(with-temporary-file (:stream s :direction :io :prefix "LEP")
   (println "Hello, World" s))
diff --git a/uiop/stream.lisp b/uiop/stream.lisp
index c647812eca78eff0308776a45bc8f8b86958355c..54daba02079be4f138ba3493906ce74ca7f7fc78 100644
--- a/uiop/stream.lisp
+++ b/uiop/stream.lisp
@@ -33,7 +33,10 @@
 (in-package :uiop/stream)
 
 (with-upgradability ()
-  (defvar *default-stream-element-type* (or #+(or abcl cmu cormanlisp scl xcl) 'character :default)
+  (defvar *default-stream-element-type*
+    (or #+(or abcl cmu cormanlisp scl xcl) 'character
+        #+lispworks 'lw:simple-char
+        :default)
     "default element-type for open (depends on the current CL implementation)")
 
   (defvar *stdin* *standard-input*
diff --git a/uiop/utility.lisp b/uiop/utility.lisp
index a7b515a24bc9996a599bf44c5d631597e940c2ee..4d6db338f1a959419a8cb1c6447bc8d27355787b 100644
--- a/uiop/utility.lisp
+++ b/uiop/utility.lisp
@@ -19,6 +19,7 @@
    #:remove-plist-keys #:remove-plist-key ;; plists
    #:emptyp ;; sequences
    #:+non-base-chars-exist-p+ ;; characters
+   #:+max-character-type-index+ #:character-type-index #:+character-types+
    #:base-string-p #:strings-common-element-type #:reduce/strcat #:strcat ;; strings
    #:first-char #:last-char #:split-string #:stripln #:+cr+ #:+lf+ #:+crlf+
    #:string-prefix-p #:string-enclosed-p #:string-suffix-p
@@ -187,9 +188,29 @@ Returns two values: \(A B C\) and \(1 2 3\)."
 
 ;;; Characters
 (with-upgradability ()
-  (defconstant +non-base-chars-exist-p+ (not (subtypep 'character 'base-char)))
+  (defconstant +non-base-chars-exist-p+ (not (subtypep 'character 'base-char))) ;; ECL, LW, SBCL
   (when +non-base-chars-exist-p+ (pushnew :non-base-chars-exist-p *features*)))
 
+(with-upgradability ()
+  (defparameter +character-types+ ;; assuming a simple hierarchy
+    #(#+non-base-chars-exist-p base-char #+lispworks lw:simple-char character))
+  (defparameter +max-character-type-index+ (1- (length +character-types+))))
+
+(with-upgradability ()
+  (defun character-type-index (x)
+    (declare (ignorable x))
+    #.(case +max-character-type-index+
+        (0 0)
+        (1 '(etypecase x
+             (character (if (typep x 'base-char) 0 1))
+             (symbol (if (subtypep x 'base-char) 0 1))))
+        (otherwise
+         '(or (position-if (etypecase x
+                             (character  #'(lambda (type) (typep x type)))
+                             (symbol #'(lambda (type) (subtypep x type))))
+               +character-types+)
+           (error "Not a character or character type: ~S" x))))))
+
 
 ;;; Strings
 (with-upgradability ()
@@ -201,10 +222,19 @@ Returns two values: \(A B C\) and \(1 2 3\)."
   (defun strings-common-element-type (strings)
     "What least subtype of CHARACTER can contain all the elements of all the STRINGS?"
     (declare (ignorable strings))
-    #-non-base-chars-exist-p 'character
-    #+non-base-chars-exist-p
-    (if (loop :for s :in strings :always (or (null s) (typep s 'base-char) (base-string-p s)))
-        'base-char 'character))
+    #.(if +non-base-chars-exist-p+
+          `(aref +character-types+
+            (loop :with index = 0 :for s :in strings :do
+              (cond
+                ((= index ,+max-character-type-index+) (return index))
+                ((emptyp s)) ;; NIL or empty string
+                ((characterp s) (setf index (max index (character-type-index s))))
+                ((stringp s) (unless (>= index (character-type-index (array-element-type s)))
+                               (setf index (reduce 'max s :key #'character-type-index
+                                                          :initial-value index))))
+                (t (error "Invalid string designator ~S for ~S" s 'strings-common-element-type)))
+                  :finally (return index)))
+          ''character))
 
   (defun reduce/strcat (strings &key key start end)
     "Reduce a list as if by STRCAT, accepting KEY START and END keywords like REDUCE.