Improvement in interop/java extensions.
When looking up a (smalltalk) method in Java class, also lookup in all
interfaces for extension with given selector. This way, one may define
common collection messages on corresponding Java interfaces to make
them polymorph with Smalltalk collections.
--- a/JavaClass.st Fri Oct 04 12:49:16 2013 +0100
+++ b/JavaClass.st Fri Oct 04 17:02:03 2013 +0100
@@ -1521,25 +1521,13 @@
(selector includes: $() ifTrue:[
"Java selector, search static methods"
method := methodDictionary at:selector ifAbsent:[nil].
- method notNil ifTrue:[
- method isStatic ifTrue:[
- ^ method
- valueWithReceiver:self arguments:args selector:selector search:self class
-
- ].
+ (method notNil and:[method isStatic]) ifTrue:[
+ ^ method valueWithReceiver:self arguments:args selector:selector search:self class
].
].
class := receiver class.
- JavaLookup isNil ifTrue:[
- (Smalltalk loadPackage: 'stx:libjava/experiments') ifFalse:[
- self error: 'You should load package stx:libjava/experiments if you want some interop - still experimental' mayProceed: true.
- ^nil
- ]
- ].
-
-
lo := class getLookupObject isNil ifTrue: [ JavaLookup instance ] ifFalse: [ class lookupObject ].
method := lo lookupMethodForSelector: selector
@@ -1549,15 +1537,15 @@
from: thisContext sender
ilc: nil.
- method isNil ifTrue:[
- ^aBlock value.
+ ^ method isNil ifTrue:[
+ aBlock value.
] ifFalse:[
- ^ method valueWithReceiver: receiver arguments: args
+ method valueWithReceiver: receiver arguments: args
].
"Created: / 19-09-2011 / 23:33:06 / Jan Kurs <kursjan@fit.cvut.cz>"
"Modified: / 10-04-2012 / 16:47:31 / kursjan"
- "Modified: / 07-09-2013 / 01:10:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-10-2013 / 16:53:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaClass methodsFor:'java initialization'!
--- a/JavaField.st Fri Oct 04 12:49:16 2013 +0100
+++ b/JavaField.st Fri Oct 04 17:02:03 2013 +0100
@@ -256,9 +256,10 @@
!
setName:aString
- name := aString.
+ name := aString asSymbol.
- "Created: 16.4.1996 / 13:04:35 / cg"
+ "Created: / 16-04-1996 / 13:04:35 / cg"
+ "Modified: / 04-10-2013 / 13:02:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setSignature:aString
--- a/JavaLookup.st Fri Oct 04 12:49:16 2013 +0100
+++ b/JavaLookup.st Fri Oct 04 17:02:03 2013 +0100
@@ -309,32 +309,78 @@
lookupMethodForSelector: selector directedTo: initialSearchClass for: receiver withArguments: argArrayOrNil from: sendingContext ilc: ilc
"
As a courtesy to a Smalltalker, try to map smalltalk selectors to a java ones.
- Returns JavaMethodDescriptor or nil."
+ Returns a method or nil"
- | name nameSizePlusOne candidates finder static cls m |
+ | name nameSizePlusOne candidates finder static cls m ifacesQ ifacesSeen |
+
+ "/ First, lookup possible extension methods in interfaces...
+ (initialSearchClass isMetaclass not and:[initialSearchClass interfaces notEmptyOrNil ] ) ifTrue:[
+ ifacesQ := OrderedCollection with: (initialSearchClass interfaces).
+ ifacesSeen := Set new.
+ [ ifacesQ notEmpty ] whileTrue:[
+ | ifaces newIfaces extension |
+
+ ifaces := ifacesQ removeFirst.
+ extension := nil.
+ ifaces do:[:iface |
+ (ifacesSeen includes: iface) ifFalse:[
+ | m |
+
+ ifacesSeen add: iface.
+ m := iface compiledMethodAt: selector.
+ m notNil ifTrue:[
+ extension notNil ifTrue:[
+ "/ Ambiguous, return error trampoline
+ | sel |
+
+ sel :=
+ #( ambiguousMessageSend
+ ambiguousMessageSendWith:
+ ambiguousMessageSendWith:With:
+ ambiguousMessageSendWith:With:With:
+ ambiguousMessageSendWith:With:With:With:
+ ambiguousMessageSendWith:With:With:With:With:
+ ambiguousMessageSendWith:With:With:With:With:With:
+ ambiguousMessageSendWith:With:With:With:With:With:With:
+ ambiguousMessageSendWith:With:With:With:With:With:With:With:
+ ) at: selector numArgs + 1.
+ ^ self class compiledMethodAt: sel.
+ ] ifFalse:[
+ extension := m.
+ ].
+ ].
+ ].
+ ].
+ extension notNil ifTrue:[ ^ extension ].
+ newIfaces := Set new.
+ ifaces do:[:iface| newIfaces addAll: iface interfaces ].
+ newIfaces notEmpty ifTrue:[
+ ifacesQ add: newIfaces.
+ ].
+ ].
+ ].
+
+
name := selector upTo: $:.
nameSizePlusOne := name size + 1.
static := receiver isBehavior.
candidates := OrderedCollection new.
- finder := [
- :cls |
- cls methodDictionary
- keysAndValuesDo: [
- :sel :mthd |
- "candidates may contain a method with same selector ->
- do not add super-class's method"
- (candidates contains: [:each | each selector == sel ]) ifFalse: [
- (mthd mclass ~~ ProxyMethod
- and: [
- ((sel size >= nameSizePlusOne)
- and: [ (sel at: nameSizePlusOne) == $( and: [ (sel startsWith: name) ] ])
- and: [ mthd descriptor numArgs == argArrayOrNil size ]
- ])
- ifTrue: [ candidates add: mthd ]
- ]
+ finder := [:cls |
+ cls methodDictionary keysAndValuesDo: [:sel :mthd |
+ "candidates may contain a method with same selector ->
+ do not add super-class's method"
+ (candidates contains: [:each | each selector == sel ]) ifFalse: [
+ (mthd mclass ~~ ProxyMethod
+ and: [
+ ((sel size >= nameSizePlusOne)
+ and: [ (sel at: nameSizePlusOne) == $( and: [ (sel startsWith: name) ] ])
+ and: [ mthd descriptor numArgs == argArrayOrNil size ]
+ ])
+ ifTrue: [ candidates add: mthd ]
]
+ ]
].
- "Search class for method candidates"
+ "Search class for method candidates"
cls := initialSearchClass theNonMetaclass.
static ifTrue: [ finder value: cls ] ifFalse: [
[ cls notNil and: [ cls ~~ JavaObject ] ] whileTrue: [
@@ -403,9 +449,9 @@
"Created: / 19-11-2011 / 13:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-01-2012 / 19:58:59 / kursjan <kursjan@fit.cvut.cz>"
"Modified (comment): / 02-01-2012 / 10:35:25 / kursjan <kursjan@fit.cvut.cz>"
- "Modified: / 17-03-2012 / 17:22:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-11-2012 / 18:17:28 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
"Modified: / 16-12-2012 / 13:59:55 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"
+ "Modified: / 04-10-2013 / 15:44:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaLookup::Smalltalk2Java methodsFor:'lookup (old)'!
@@ -550,6 +596,115 @@
"Created: / 06-09-2011 / 22:20:34 / Jan Kurs <kursjan@fit.cvut.cz>"
! !
+!JavaLookup::Smalltalk2Java methodsFor:'trampolines'!
+
+ambiguousMessageSend
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: #()
+ )
+
+ "Created: / 19-08-2010 / 22:05:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1)
+ )
+
+ "Created: / 19-08-2010 / 22:06:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1 with: a2
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1 with: a2)
+ )
+
+ "Created: / 19-08-2010 / 22:06:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1 with: a2 with: a3
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1 with: a2 with: a3)
+ )
+
+ "Created: / 19-08-2010 / 22:06:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1 with: a2 with: a3 with: a4)
+ )
+
+ "Created: / 19-08-2010 / 22:06:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
+ with: a5
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5)
+ )
+
+ "Created: / 19-08-2010 / 22:07:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6)
+ )
+
+ "Created: / 19-08-2010 / 22:07:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6 with: a7
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6 with: a7)
+ )
+
+ "Created: / 19-08-2010 / 22:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+ambiguousMessageSendWith: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6 with: a7 with: a8
+
+ ^self ambiguousMessage:
+ (Message
+ selector: thisContext selector
+ arguments: (Array with: a1 with: a2 with: a3 with: a4
+ with: a5 with: a6 with: a7 with: a8)
+ )
+
+ "Created: / 19-08-2010 / 22:08:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!JavaLookup::Smalltalk2Java methodsFor:'utilities'!
addSelector:selector withMethod:proxy toClass:class
--- a/JavaLookupTests.st Fri Oct 04 12:49:16 2013 +0100
+++ b/JavaLookupTests.st Fri Oct 04 17:02:03 2013 +0100
@@ -133,6 +133,49 @@
"Modified: / 30-11-2012 / 22:13:34 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
+!JavaLookupTests methodsFor:'tests - java extensions'!
+
+test_java_extension_01
+
+ Compiler compile: 'fooPerson ^ 0' forClass: JAVA cz cvut fit swing methodLookup Person theClass.
+ self assert: JAVA cz cvut fit swing methodLookup Person new fooPerson == 0.
+
+ "Created: / 04-10-2013 / 15:07:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_java_extension_02_1
+
+ Compiler compile: 'fooIPerson1 ^ 1' forClass: JAVA cz cvut fit swing methodLookup IPerson1 theClass.
+ self assert: JAVA cz cvut fit swing methodLookup Person new fooIPerson1 == 1.
+
+ "Created: / 04-10-2013 / 15:13:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_java_extension_02_2
+
+ Compiler compile: 'fooIPerson2 ^ 2' forClass: JAVA cz cvut fit swing methodLookup IPerson2 theClass.
+ self assert: JAVA cz cvut fit swing methodLookup Person new fooIPerson2 == 2
+
+ "Created: / 04-10-2013 / 15:12:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_java_extension_03
+
+ Compiler compile: 'fooIPersonSuper ^ 3' forClass: JAVA cz cvut fit swing methodLookup IPersonSuper theClass.
+ self assert: JAVA cz cvut fit swing methodLookup Person new fooIPersonSuper == 3
+
+ "Created: / 04-10-2013 / 15:11:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_java_extension_04
+
+ Compiler compile: 'fooIPerson ^ 3' forClass: JAVA cz cvut fit swing methodLookup IPerson1 theClass.
+ Compiler compile: 'fooIPerson ^ 4' forClass: JAVA cz cvut fit swing methodLookup IPerson2 theClass.
+ self should:[self assert: JAVA cz cvut fit swing methodLookup Person new fooIPerson] raise: Object ambiguousMessageSignal
+
+ "Created: / 04-10-2013 / 15:43:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!JavaLookupTests methodsFor:'tests - java lookup'!
test3
--- a/JavaMethod.st Fri Oct 04 12:49:16 2013 +0100
+++ b/JavaMethod.st Fri Oct 04 17:02:03 2013 +0100
@@ -1924,6 +1924,11 @@
|numArgs numJArgs returnType|
+ "/ Force Symbol creation so Smalltalk syntax highlighter will not
+ "/ mark them as unknown message (it detects this solely by existence
+ "/ of the symbol.
+ nameString asSymbol.
+
selector := (nameString , aString) asSymbol.
self setDescriptor:aString.
@@ -1953,6 +1958,7 @@
].
"Created: / 14-08-2011 / 19:41:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-10-2013 / 13:02:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setSignature:aString
--- a/Make.proto Fri Oct 04 12:49:16 2013 +0100
+++ b/Make.proto Fri Oct 04 17:02:03 2013 +0100
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES=-I$(ZLIB_DIR) -Isupport/fdlibm -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic3 -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libview
+LOCALINCLUDES=-I$(ZLIB_DIR) -Isupport/fdlibm -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic3 -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libview
# if you need any additional defines for embedded C code,
@@ -144,6 +144,8 @@
cd ../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
cd ../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd ../goodies/sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
--- a/abbrev.stc Fri Oct 04 12:49:16 2013 +0100
+++ b/abbrev.stc Fri Oct 04 17:02:03 2013 +0100
@@ -37,7 +37,6 @@
JavaFieldRefTests JavaFieldRefTests stx:libjava 'Languages-Java-Tests-RuntimeConstantPool' 1
JavaFinalizationRegistry JavaFinalizationRegistry stx:libjava 'Languages-Java-Support' 0
JavaFreshlyInitializedResource JavaFreshlyInitializedResource stx:libjava 'Languages-Java-Tests' 1
-JavaInitializedResource JavaInitializedResource stx:libjava 'Languages-Java-Tests' 2
JavaInterfaceMethodRefTests JavaInterfaceMethodRefTests stx:libjava 'Languages-Java-Tests-RuntimeConstantPool' 1
JavaJUnitTests JavaJUnitTests stx:libjava 'Languages-Java-Tests-Libraries' 1
JavaLanguage JavaLanguage stx:libjava 'Languages-Java-Support' 1
@@ -114,6 +113,7 @@
JavaFieldAnnotationContainer JavaFieldAnnotationContainer stx:libjava 'Languages-Java-Annotations' 1
JavaFieldDescriptor JavaFieldDescriptor stx:libjava 'Languages-Java-Support' 0
JavaFieldDescriptorWithUnionType JavaFieldDescriptorWithUnionType stx:libjava 'Languages-Java-Support' 0
+JavaInitializedResource JavaInitializedResource stx:libjava 'Languages-Java-Tests' 2
JavaInvalidRefError JavaInvalidRefError stx:libjava 'Languages-Java-Support' 1
JavaMethod JavaMethod stx:libjava 'Languages-Java-Classes' 0
JavaMethodAnnotationContainer JavaMethodAnnotationContainer stx:libjava 'Languages-Java-Annotations' 1
--- a/bc.mak Fri Oct 04 12:49:16 2013 +0100
+++ b/bc.mak Fri Oct 04 17:02:03 2013 +0100
@@ -34,7 +34,7 @@
-LOCALINCLUDES=-I$(ZLIB_DIR) -Isupport\fdlibm -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic3 -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libview
+LOCALINCLUDES=-I$(ZLIB_DIR) -Isupport\fdlibm -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic3 -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libview
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -54,6 +54,8 @@
pushd ..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
pushd ..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\goodies\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
--- a/libjava.rc Fri Oct 04 12:49:16 2013 +0100
+++ b/libjava.rc Fri Oct 04 17:02:03 2013 +0100
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2011\nCopyright eXept Software AG 1998-2011\nCopyright Jan Vrany, Jan Kurs and Marcel Hlopko\n SWING Research Group, Czech Technical University In Prague\0"
VALUE "ProductName", "Smalltalk/X\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Fri, 04 Oct 2013 11:13:21 GMT\0"
+ VALUE "ProductDate", "Fri, 04 Oct 2013 15:56:12 GMT\0"
END
END
--- a/stx_libjava.st Fri Oct 04 12:49:16 2013 +0100
+++ b/stx_libjava.st Fri Oct 04 17:02:03 2013 +0100
@@ -160,6 +160,7 @@
(the browser has a menu function for that)"
^ #(
+ #'stx:goodies/sunit' "TestAsserter - superclass of JavaAntProjectResource "
#'stx:libbasic' "AbstractNumberVector - extended "
#'stx:libbasic2' "BitArray - extended "
#'stx:libbasic3' "WrappedMethod - extended "
@@ -176,7 +177,6 @@
exclude individual packages in the #excludedFromPreRequisites method."
^ #(
- #'stx:goodies/sunit' "TestSuite - referenced by JavaTestsLoader class>>buildSuiteFrom: "
#'stx:libcomp' "BlockNode - referenced by JavaNativeMethod>>numberOfArgs: "
#'stx:libhtml' "URL - referenced by JavaEmbeddedFrameView>>setupAppletFrameIn:initializeJava: "
#'stx:libtool' "DebugView - referenced by Java class>>flushClasses "
@@ -343,7 +343,6 @@
(JavaFieldRefTests autoload)
JavaFinalizationRegistry
(JavaFreshlyInitializedResource autoload)
- (JavaInitializedResource autoload)
(JavaInterfaceMethodRefTests autoload)
(JavaJUnitTests autoload)
JavaLanguage
@@ -420,6 +419,7 @@
JavaFieldAnnotationContainer
JavaFieldDescriptor
JavaFieldDescriptorWithUnionType
+ (JavaInitializedResource autoload)
JavaInvalidRefError
JavaMethod
JavaMethodAnnotationContainer