Changeset 15086

Timestamp:

06/17/17 06:52:37 (6 years ago)

Author:

Mark Evenson

Message:

jss: new macro WITH-CLASS-LOOKUP-DISAMBIGUATED
(Alan Ruttenberg)

(with-class-lookup-disambiguated (lang.object) (find-java-class 'object))

-> success (otherwise error: ambiguous)

From <​https://github.com/armedbear/abcl/pull/57>.

Merges
<​https://github.com/armedbear/abcl/pull/57/commits/5103d57822691d74c66b80c754f8438df6806bba>.

Location:

trunk/abcl/contrib/jss

Files:

• invoke.lisp (modified) (1 diff)
• t/jss-tests.lisp (modified) (2 diffs)

trunk/abcl/contrib/jss/invoke.lisp

@@ -246 +246 @@
                  ,@body)))))))
 
+(defvar *class-lookup-overrides*)
+
+(defmacro with-class-lookup-disambiguated (overrides &body body)
+  "Suppose you have code that references class using the symbol 'object, and this is ambiguous. E.g. in my system java.lang.Object, org.omg.CORBA.Object. Use (with-class-lookup-disambiguated (lang.object) ...). Within dynamic scope, find-java-class first sees if any of these match, and if so uses them to lookup the class."
+  `(let ((*class-lookup-overrides* ',overrides))
+     ,@body))
+
+(defun maybe-found-in-overridden (name)
+  (when (boundp '*class-lookup-overrides*)
+      (let ((found (find-if (lambda(el) (#"matches" (string el) (concatenate 'string "(?i).*" (string name) "$")))
+          *class-lookup-overrides*)))
+  (if found
+      (let ((*class-lookup-overrides* nil))
+        (lookup-class-name found))))))
+
+
 (defun lookup-class-name (name &key
                                  (table *class-name-to-full-case-insensitive*)
                                  (muffle-warning nil)
                                  (return-ambiguous nil))
+  (let ((overridden (maybe-found-in-overridden name)))
+    (when overridden (return-from lookup-class-name overridden)))
   (setq name (string name))
   (let* (;; cant (last-name-pattern (#"compile" '|java.util.regex.Pattern| ".*?([^.]*)$"))

trunk/abcl/contrib/jss/t/jss-tests.lisp

@@ -1 +1 @@
 (in-package :cl-user)
 
-(prove:plan 6)
+(prove:plan 8)
 
 (prove:is
@@ -23 +23 @@
            (find "size" (#"getMethods" (find-java-class "java.util.Collections$UnmodifiableMap"))
                  :test 'string-equal :key #"getName"))
-    (#"toString" (java::jmethod "java.util.Collections$UnmodifiableMap" "size" )))
+    (#"toString" (java::jmethod "java.util.Collections$UnmodifiableMap" "size" )))
+
+(prove:is 
+ (jss::with-class-lookup-disambiguated (lang.object) (find-java-class 'object))
+ (find-java-class 'java.lang.object))
+
+;; Object is ambiguous in default java 
+(prove:is-error
+ (find-java-class 'object)
+ 'simple-error)
 
 ;; test that optimized jss is much faster than unoptimized