"
COPYRIGHT (c) 1996-2011 by Claus Gittinger
COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko
SWING Research Group, Czech Technical University in Prague (*)
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
(*) extensions, changes and fixes for java1.1 compatibility.
For a list of changes, see a list of diffs against the last stable version before 2011-08.
"
"{ Package: 'stx:libjava' }"
JavaBehavior subclass:#JavaClass
instanceVariableNames:'classLoader fullName sourceFile binaryFilePath fields initValues
staticFields annotations protectionDomain signatureJ'
classVariableNames:'ArgumentConversionErrorSignal OrderOfClassInits'
poolDictionaries:''
category:'Languages-Java-Classes'
!
!JavaClass class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1996-2011 by Claus Gittinger
COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko
SWING Research Group, Czech Technical University in Prague (*)
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
(*) extensions, changes and fixes for java1.1 compatibility.
For a list of changes, see a list of diffs against the last stable version before 2011-08.
"
!
documentation
"
fields upTo-and-including accessFlags are known & used by the VM
only add fields after those and keep their order intact.
"
!
examples
"
(Java at:'java.util.Stack') new inspect
(Java at:'java.util.Vector') new inspect
"
! !
!JavaClass class methodsFor:'instance creation'!
fullName:aString
self shouldNotImplement.
^ self new flags:0; setFullName:aString
!
fullName:aString numStatic:nStatic
|meta cls s ns nameComponents|
"/ check for a JAVA nameSpace to exist
JAVA isNil ifTrue:[
NameSpace name:'JAVA'
].
"create the metaclass first"
meta := Metaclass new.
meta setSuperclass:(self).
meta instSize:(JavaClass instSize + nStatic).
"/ meta setName:(aString , 'class') asSymbol.
"/ meta setClassVariableString:''.
meta flags:(meta flags bitOr:Behavior flagJavaClass).
"/ meta setSuperclass:JavaObject class.
"then let the new meta create the class"
cls := meta new.
cls setSuperclass:JavaObject.
cls instSize:0.
cls setName:('JAVA::' , aString).
cls flags:0.
cls setAccessFlags:0.
"/ cls setClassVariableString:''.
cls setInstanceVariableString:''.
cls setCategory:#java.
cls setFullName:aString.
"/ java classes do not really have a category;
"/ simulate one by separating its name into individual components,
"/ prepending 'java'"
nameComponents := aString asCollectionOfSubstringsSeparatedBy:$/.
nameComponents size > 1 ifTrue:[
cls category:((nameComponents asStringWith:$/ from:1 to:(nameComponents size - 1))
replaceAll:$/ with:$. ).
].
nameComponents size > 1 ifTrue:[
cls setPackage:((nameComponents copyWithoutLast:1) asStringWith:$/) asSymbol
] ifFalse:[
cls setPackage:aString asSymbol
].
"/ break up the package and create nameSpaces
"/ for each package component.
"/ This allows java.foo.bar to be visible in ST/X
"/ under the name JAVA::java::foo::bar
ns := JAVA.
nameComponents size > 1 ifTrue:[
s := '' writeStream.
s nextPutAll:'JAVA'.
nameComponents from:1 to:(nameComponents size - 1) do:[:aPart |
s nextPutAll:'::'.
s nextPutAll:aPart
].
Metaclass confirmationQuerySignal answer:false do:[
Class updateChangeFileQuerySignal answer:false do:[
ns := NameSpace fullName:(s contents).
]
]
].
ns isNameSpace ifTrue:[
ns at:nameComponents last asSymbol put:cls.
].
"/ for ST/X browsing
Smalltalk at:('JAVA::' , aString) asSymbol put:cls.
^ cls
"Created: / 15-04-1996 / 15:52:55 / cg"
"Modified: / 03-01-1998 / 22:32:25 / cg"
"Modified: / 26-11-2010 / 19:00:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
name:aString
self shouldNotImplement
"Created: 15.4.1996 / 15:52:55 / cg"
! !
!JavaClass class methodsFor:'class initialization'!
initialize
ArgumentConversionErrorSignal := Signal new notifierString:'argument conversion error'.
"Created: / 20-10-2010 / 11:11:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaClass class methodsFor:'method lookup'!
canConvertArgsToJava:argArray asSpecifiedIn:argSigSpecArray
"given a smalltalk argument array, return true, if these can be converted to java objects as appropriate."
argArray
with:argSigSpecArray
do:[:arg :type |
self
convertToJava:arg
type:type
ifFail:[:msg :default| ^ false]].
^ true
"Created: / 5.11.1998 / 18:25:05 / cg"
"Modified: / 6.11.1998 / 00:45:58 / cg"
!
convertArgsToJava:argArray asSpecifiedIn:argSigSpecArray numArgs:na
"given a smalltalk argument array, convert to java objects as appropriate.
Currently, only Strings and booleans are converted."
|sigIndex newArgIndex newArgArray|
sigIndex := newArgIndex := 1.
newArgArray := Array new:na.
argArray do:[:arg |
|type newArg|
type := argSigSpecArray at:sigIndex.
sigIndex := sigIndex + 1.
newArg := self convertToJava:arg type:type.
newArgArray at:newArgIndex put:newArg.
newArgIndex := newArgIndex + 1.
(type == #long or:[type == #double]) ifTrue:[
newArgIndex > na ifTrue:[
self halt:'should not happen'
].
newArgArray at:newArgIndex put:nil.
newArgIndex := newArgIndex + 1.
]
].
^ newArgArray
"Created: / 5.11.1998 / 18:30:57 / cg"
"Modified: / 6.11.1998 / 00:45:00 / cg"
!
convertToJava:arg type:type
"given a smalltalk argument, convert to a java object as appropriate."
^ self
convertToJava:arg
type:type
ifFail:[:msg :default |
ArgumentConversionErrorSignal
raiseWith:arg
errorString:msg.
default
]
"Created: / 06-11-1998 / 00:45:13 / cg"
"Modified: / 20-10-2010 / 11:08:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
convertToJava:arg type:type ifFail:failBlock
"given a smalltalk argument, convert to a java object as appropriate.
Currently, only a few types are converted."
|expectedCls f failValue|
type == #boolean ifTrue:[
arg == true ifTrue:[
^ 1
].
arg == false ifTrue:[
^ 0
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
type == #int ifTrue:[
arg isInteger ifTrue:[
(arg between: (16r8000000 * -1) and:16r7FFFFFFF) ifTrue:[
^ arg
].
^ failBlock value:('integer range; cannot convert argument to ' , type) value:0.
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
type == #long ifTrue:[
arg isInteger ifTrue:[
(arg between:"(-1 * 16r800000000000000) -->"-576460752303423488 and:16r7FFFFFFFFFFFFFFF) ifTrue:[
^ arg
].
^ failBlock value:('integer range; cannot convert argument to ' , type) value:0
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
(type == #float) ifTrue:[
arg isLimitedPrecisionReal ifTrue:[
^ arg asShortFloat
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type = 'java.lang.Float') ifTrue:[
arg isLimitedPrecisionReal ifTrue:[
f := (Java at:'java.lang.Float') new.
f perform:#'<init>(F)V' with:(arg asShortFloat).
self halt.
^ f.
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type = 'java.lang.Double') ifTrue:[
arg isLimitedPrecisionReal ifTrue:[
f := (Java at:'java.lang.Double') new.
f perform:#'<init>(D)V' with:(arg asFloat).
self halt.
^ f.
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type == #double) ifTrue:[
arg isLimitedPrecisionReal ifTrue:[
^ arg asFloat
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type == #char) ifTrue:[
arg isCharacter ifTrue:[
^ arg asciiValue
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
(type = 'char[]') ifTrue:[
arg isString ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'int[]') ifTrue:[
(arg isArray or:[arg isMemberOf:SignedIntegerArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'long[]') ifTrue:[
(arg isArray or:[arg isMemberOf:SignedIntegerArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'float[]') ifTrue:[
(arg isArray or:[arg isMemberOf:FloatArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'double[]') ifTrue:[
(arg isArray or:[arg isMemberOf:DoubleArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type endsWith:'[]') ifTrue:[
(arg isArray or:[arg isNil]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
expectedCls := Java classForName:type.
(arg isKindOf:expectedCls) ifTrue:[
"/ matches class and subclasses
^ arg
].
(type = 'java.lang.Object') ifTrue:[
"/ matches any
^ arg
].
(type = 'java.lang.String') ifTrue:[
arg isString ifTrue:[
^ Java as_String:arg
].
failValue := ''
].
arg isNil ifTrue:[
"/ matches any
^ arg
].
self halt.
^ failBlock value:('cannot convert argument to ' , type) value:failValue
"Created: / 06-11-1998 / 00:46:19 / cg"
"Modified: / 06-11-2001 / 13:28:29 / cg"
"Modified: / 17-01-2011 / 10:08:04 / kursjan <kursjan@fit.cvut.cz>"
"Modified: / 17-03-2011 / 14:09:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
convertToSmalltalk:jObj type:type
"given a java return value, convert to a smalltalk object as appropriate.
Currently, only a few types are converted."
"JV@2011-02-04"
"Hack for primitive types"
(JavaDescriptor baseTypesByTypeName keys includes: type) ifTrue:[^jObj].
"jObj is registered for the specified type?"
"
(JavaObjectDictionary new reflectionOf: jObj class name) = (Java classForName: type) ifTrue: [
^ jObj
].
"
type == #boolean ifTrue:[
jObj == 0 ifTrue:[
^ false
].
^ true
].
type == #void ifTrue:[
^ nil
].
(type = 'java.lang.String') ifTrue:[
^ Java as_ST_String:jObj
].
"/ (type = 'java.lang.Float') ifTrue:[
"/ ^ jObj instVarNamed:'value'
"/ ].
"/ (type = 'java.lang.Double') ifTrue:[
"/ ^ jObj instVarNamed:'value'
"/ ].
(type == #char) ifTrue:[
jObj isInteger ifTrue:[
^ Character value:jObj
].
].
^ jObj
"Created: / 06-11-1998 / 00:49:53 / cg"
"Modified: / 11-11-1998 / 02:08:11 / cg"
"Modified: / 17-01-2011 / 10:42:56 / kursjan <kursjan@fit.cvut.cz>"
"Modified: / 08-04-2011 / 17:04:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lookupMethod:selector numArgs:nargs in:aClass static:staticMethod
"lookup a method"
|method cls sel|
sel := selector.
(sel includes:$:) ifTrue:[
sel := sel copyTo:(sel indexOf:$:)-1
].
sel := sel asSymbolIfInterned.
sel notNil ifTrue:[
cls := aClass.
[cls notNil
and:[cls ~~ JavaObject
and:[cls ~~ JavaClass]]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:jSel :m |
|aMethod|
aMethod := m.
aMethod isWrapped ifTrue:[
aMethod := aMethod originalMethod
].
((jSel == sel)
or:[aMethod name = sel
or:[aMethod signatureNameWithoutReturnType = sel]])
ifTrue:[
aMethod numArgs == nargs ifTrue:[
staticMethod == (aMethod isStatic) ifTrue:[
^ m
]
]
]
].
cls := cls superclass.
].
].
"/ self halt.
^ nil
"Created: / 17.8.1997 / 18:25:47 / cg"
"Modified: / 16.11.1998 / 16:46:48 / cg"
!
lookupMethods:selector numArgs:nargs in:aClass static:staticMethod
"lookup methods matching a selector.
This is a special entry for doesNotUnderstand redirection
(the caller must select the one method which fits the argument(s) best."
|methods cls sel|
sel := selector.
(sel includes:$:) ifTrue:[
sel := sel copyTo:(sel indexOf:$:)-1
].
sel := sel asSymbolIfInterned.
sel notNil ifTrue:[
cls := aClass.
[cls notNil
and:[cls ~~ JavaObject
and:[cls ~~ JavaClass]]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:jSel :aMethod |
((jSel == sel)
or:[aMethod name = sel
or:[aMethod signatureNameWithoutReturnType = sel]])
ifTrue:[
(nargs isNil
or:[aMethod numArgs == nargs]) ifTrue:[
staticMethod == (aMethod isStatic) ifTrue:[
methods isNil ifTrue:[
methods := OrderedCollection new
].
methods add:aMethod
]
]
]
].
cls := cls superclass.
].
].
^ methods ? #()
"Created: / 4.11.1998 / 19:04:51 / cg"
"Modified: / 4.11.1998 / 19:31:33 / cg"
! !
!JavaClass class methodsFor:'signature parsing'!
initialValueFromSignature:aSignature
"given a signature, return an initializer value"
|s|
s := aSignature readStream.
^ self initialValueFromStream:s.
"
JavaClass initialValueFromSignature:'LObject;'
JavaClass initialValueFromSignature:'B'
JavaClass initialValueFromSignature:'I'
"
! !
!JavaClass class methodsFor:'special'!
deinitClasses
Smalltalk allClassesDo:
[:cls|cls isJavaClass ifTrue:[cls deinit]].
self flushClassesInitOrder.
"
JavaClass deinitClasses
"
"Created: / 25-10-2010 / 16:47:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
flushClassesInitOrder
OrderOfClassInits := nil
"Created: / 6.11.2001 / 09:49:49 / cg"
!
orderOfClassInits
^ OrderOfClassInits
"Created: / 12.11.1998 / 15:35:57 / cg"
!
setInstanceVariableStringFromFields:f in:aClass
|varNames|
varNames := ''.
f do:[:aField |
varNames := varNames , aField name , ' '
].
aClass setInstanceVariableString:varNames.
"Created: 15.4.1996 / 16:42:52 / cg"
!
startRememberingOrderOfClassInits
OrderOfClassInits := OrderedCollection new.
"Created: / 12.11.1998 / 15:26:32 / cg"
"Modified: / 12.11.1998 / 15:29:10 / cg"
! !
!JavaClass methodsFor:'accessing'!
allInterfaces
| ifaces cls |
ifaces := Set new.
cls := self.
[ cls isJavaClass ] whileTrue:
[cls interfaces do:[:iface| ifaces add: iface; addAll: iface allInterfaces].
cls := cls superclass].
^ifaces.
"Created: / 05-02-2011 / 23:51:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
annotations
^ annotations ifNil:[JavaClassAnnotationContainer empty].
"Modified: / 03-03-2011 / 22:52:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
annotations:something
annotations := something.
!
binaryFile
^ binaryFilePath
!
category
"java classes do not really have a category;
simulate one by separating its name into individual components,
prepending 'java'"
|nameComponents|
nameComponents := fullName asCollectionOfSubstringsSeparatedBy:$/.
nameComponents size <= 1 ifTrue:[
^ 'java' "/ fullName
].
^ ((nameComponents asStringWith:$/ from:1 to:(nameComponents size - 1)))
replaceAll:$/ with:$.
"Modified: 30.7.1997 / 15:35:22 / cg"
!
classLoader
^ classLoader
!
classLoader:aJavaClassLoaderOrNil
classLoader := aJavaClassLoaderOrNil
!
compiledMethodAt:name
"redefined to find the constructor"
|m|
m := super compiledMethodAt:name.
m isNil ifTrue:[
name = self lastName ifTrue:[
^ super compiledMethodAt:#'<init>()V'
].
].
^ m
"
JAVA::java::lang::Object compiledMethodAt:#Object
"
"Created: / 24.12.1999 / 02:02:50 / cg"
"Modified: / 24.12.1999 / 02:04:46 / cg"
!
compiledMethodAt:name signature:sig
"lookup the classes methodDictionary"
methodDictionary keysAndValuesDo:[:mFullSelector :aMethod |
aMethod name == name ifTrue:[
aMethod signature == sig ifTrue:[
^ aMethod
]
]
].
^ nil
"Created: 1.8.1997 / 00:01:58 / cg"
!
constantPool
^ constantPool
!
ensureHasAnnotations
annotations ifNil: [ annotations := JavaAnnotationContainer for: self ].
^ annotations
"Created: / 25-02-2011 / 16:02:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-03-2011 / 17:13:47 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
fields
^ fields
!
fullName
^ fullName
!
interfaces
interfaces notNil
ifTrue:
[ interfaces := interfaces collect:
[:clsRef | clsRef javaClass ] ].
^ interfaces ? #()
"Modified: / 31-05-2011 / 09:40:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
javaClass
^ self
"Modified: / 22-05-2011 / 13:32:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
javaComponentClass
^self.
"Created: / 20-12-2010 / 22:02:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-05-2011 / 23:26:13 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
javaName
"the javaname - as seen by a java programmer.
(with '/'s replaced by dots) extract from the fullName"
^ fullName copyReplaceAll:$/ with:$.
"
Java allClasses first fullName
Java allClasses first name
Java allClasses first javaName
Java allClasses first javaPackage
Java allClasses first package
"
!
javaPackage
"the javaPackage - as seen by a java programmer.
(with '/'s replaced by dots) extract from the fullName"
|components|
components := fullName asCollectionOfSubstringsSeparatedBy:$/.
components size > 1 ifTrue:[
^ (components copyWithoutLast:1) asStringWith:$.
].
^ fullName
"
Java allClasses first fullName
Java allClasses first javaPackage
Java allClasses first package
"
!
javaPackageAsDirname
"the javaPackage - as directory in class path"
|components|
components := fullName asCollectionOfSubstringsSeparatedBy:$/.
components size > 1 ifTrue:[
^ (components copyWithoutLast:1) asStringWith: Filename separator
].
^ fullName
"
Java allClasses first fullName
Java allClasses first javaPackage
Java allClasses first package
"
"Created: / 30-11-2010 / 12:17:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lastName
^ fullName copyFrom:(fullName lastIndexOf:$/)+1
"Created: / 5.11.1998 / 19:16:00 / cg"
!
name
^ name "/ fullName
!
nameSpace
^ JAVA
"Created: 20.1.1997 / 13:04:30 / cg"
!
nameWithoutNameSpacePrefix
^ fullName
"Created: 20.1.1997 / 13:05:30 / cg"
!
nameWithoutPrefix
^ fullName
"Created: 20.1.1997 / 13:06:06 / cg"
!
package
"the package (as seen by a smalltalk programmer)
extract from the fullName, (with '/'s) and prepend 'java:'"
|components p i|
i := fullName lastIndexOf:$/.
p := fullName copyTo:i - 1.
p size == 0 ifTrue:[
^ 'java'
].
"/ components := fullName asCollectionOfSubstringsSeparatedBy:$/.
"/ components size > 1 ifTrue:[
"/ p := (components copyWithoutLast:1) asStringWith:$/
"/ ] ifFalse:[
"/ p := fullName
"/ ].
^ 'java:' , p
"
Java allClasses first fullName
Java allClasses first package
Java allClasses first javaPackage
"
!
protectionDomain
^ protectionDomain
!
protectionDomain:something
protectionDomain := something.
!
runtimeVisibleAnnotationsAsBytesOrNil
annotations ifNil:[ ^ nil ].
annotations runtimeVisible ifNil:[ ^ nil ].
^ annotations runtimeVisible bytes
"Created: / 25-02-2011 / 16:48:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setSignature: aSymbol
signatureJ := aSymbol
"Created: / 13-08-2011 / 00:30:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
signatureJ
"stupid naming, but superclass defines signature too"
^signatureJ
"Created: / 13-08-2011 / 00:30:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
source
^ Java classSourceOf:self
"
(Java at:'java.awt.Frame') source
(Java at:'ArcTest') source
(Java at:'ArcCanvas') source
"
"Modified: 30.7.1997 / 14:31:01 / cg"
!
sourceFile
^ sourceFile
!
staticFields
^ staticFields
!
superinterface
| ifaces |
self assert: self isInterface message: 'Type must be an interface'.
(ifaces := self interfaces) size == 0 ifTrue:[^nil].
ifaces size = 1 ifTrue:[^ifaces first].
self error: 'Should not happen!!'.
^nil
"Created: / 04-02-2011 / 12:35:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
typeOfField:aFieldName
fields do:[:aField |
aField name = aFieldName ifTrue:[
^ aField type
]
].
self error:'no such field'
"
(JAVA at:#'java/awt/image/ColorModel') typeOfField:'pixel_bits'
"
"Modified: 21.1.1997 / 22:48:28 / cg"
! !
!JavaClass methodsFor:'adding / removing'!
removeFromSystem
Java removeClass:self
"Created: 12.8.1997 / 02:46:51 / cg"
! !
!JavaClass methodsFor:'autoboxing'!
javaBox:anObject
^ anObject
"Created: / 14-08-2011 / 22:58:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaClass methodsFor:'browser interface'!
isVisualStartable
"return true, if this is an application class,
which can be started via #open"
"/ if I have a main() method, I am
(self compiledMethodAt:#'main([Ljava/lang/String;)V') notNil ifTrue:[
^ true
].
(self isSubclassOf:(Java at:'java.applet.Applet')) ifTrue:[
^ true.
].
^ false
!
open
"start a thread for my main method"
"/ if I have a main, call it ...
(self compiledMethodAt:#'main([Ljava/lang/String;)V') notNil ifTrue:[
^ self startMain
].
"/ otherwise, create a frame and wrap me;
"/ as in:
"/ public static void main(String args[]) {
"/ Frame f = new Frame("myName");
"/ mySelf me = new mySelf();
"/
"/ me.init();
"/ me.start();
"/
"/ f.add("Center", me);
"/ f.setSize(300, 300);
"/ f.show();
"/ }
^ self startApplet
"Created: / 15.1.1998 / 17:18:30 / cg"
"Modified: / 3.11.1998 / 22:51:47 / cg"
! !
!JavaClass methodsFor:'compiler interface'!
browserClass
"return the browser to use for this class -
this can be redefined in special classes, to get different browsers"
"/ ^ JavaBrowser
^ super browserClass.
"Modified: / 14.10.1998 / 15:28:38 / cg"
! !
!JavaClass methodsFor:'compiling'!
recompileMethodsAccessingGlobal:aGlobalKey
"/ dummy for now
"Created: / 9.11.1999 / 16:42:09 / cg"
! !
!JavaClass methodsFor:'documentation support'!
htmlDocumentation
^ nil "/ replace by access to javadoc-generated documentation later
"Modified: 22.3.1997 / 14:18:50 / cg"
! !
!JavaClass methodsFor:'executing programs'!
startApplet
|f me stub top appFrame|
top := StandardSystemView new.
appFrame := JavaEmbeddedFrameView new.
appFrame origin:0.0@0.0 corner:1.0@1.0.
top addSubView:appFrame.
appFrame appletIsPreloaded:true.
appFrame codeURL:'file:/dummy'.
appFrame codeBaseURL:'file:/dummy'.
appFrame autoSetupApplet:true.
appFrame autoStartApplet:true.
appFrame autoDestroyApplet:true.
top open.
^ self.
"/ TODO: setup embeddedAppletFrame correctly
"/ (for getParameter to work ...)
"/ create a frame and wrap me;
"/ as in:
"/ public static void main(String args[]) {
"/ Frame f = new Frame("myName");
"/ mySelf me = new mySelf();
"/
"/ me.init();
"/ me.start();
"/
"/ f.add("Center", me);
"/ f.setSize(300, 300);
"/ f.show();
"/ }
f := (Java at:'java.awt.Frame') basicNew.
f perform:#'<init>(Ljava/lang/String;)V' with:(Java as_String:self name).
self halt.
me := self basicNew.
me perform:#'<init>()V'.
self halt.
stub := (Java at:'netscape.applet.EmbeddedAppletFrame') new.
me instVarNamed:'stub' put:stub.
self halt.
me perform:#'init()V'.
me perform:#'start()V'.
self halt.
f perform:#'add(Ljava/lang/String;Ljava/awt/Component;)Ljava/awt/Component;'
with:(Java as_String:'Center')
with:me.
self halt.
f perform:#'setSize(II)V' with:300 with:300.
self halt.
f perform:#'show()V'.
self halt.
"Modified: / 3.11.1998 / 23:04:41 / cg"
"/ TODO: setup embeddedAppletFrame correctly
"/ (for getParameter to work ...)
"/ create a frame and wrap me;
"/ as in:
"/ public static void main(String args[]) {
"/ Frame f = new Frame("myName");
"/ mySelf me = new mySelf();
"/
"/ me.init();
"/ me.start();
"/
"/ f.add("Center", me);
"/ f.setSize(300, 300);
"/ f.show();
"/ }
f := (Java at:'java.awt.Frame') basicNew.
f perform:#'<init>(Ljava/lang/String;)V' with:(Java as_String:self name).
self halt.
me := self basicNew.
me perform:#'<init>()V'.
self halt.
stub := (Java at:'netscape.applet.EmbeddedAppletFrame') new.
me instVarNamed:'stub' put:stub.
self halt.
me perform:#'init()V'.
me perform:#'start()V'.
self halt.
f perform:#'add(Ljava/lang/String;Ljava/awt/Component;)Ljava/awt/Component;'
with:(Java as_String:'Center')
with:me.
self halt.
f perform:#'setSize(II)V' with:300 with:300.
self halt.
f perform:#'show()V'.
self halt.
"Modified: / 3.11.1998 / 23:04:41 / cg"
!
startMain
"start a thread for my main() method"
^ self startMainWithArgumentString:nil
"Modified: / 30.12.1998 / 20:24:58 / cg"
!
startMainWithArgumentString:aCommandLineString
"start a thread for my main() method, passing a string with arguments"
|p|
p := Java javaProcessForMainOf:self argumentString:aCommandLineString.
p notNil ifTrue:[
p resume.
Object abortSignal handle:[:ex |
p == JavaVM javaScreenUpdaterThread ifTrue:[self halt].
p == JavaVM javaEventQueueThread ifTrue:[self halt].
p terminate.
ex reject.
] do:[
p waitUntilTerminated
].
]
"Modified: / 24.12.1999 / 02:35:04 / cg"
! !
!JavaClass methodsFor:'fileOut'!
basicFileOutDefinitionOn:aStream withNameSpace:nameSpaceBoolean
JavaDecompiler definitionOf:self on:aStream
"Modified: 22.3.1997 / 14:30:28 / cg"
!
fileOut
self warn:'fileOut not yet supported'
"Modified: 22.3.1997 / 14:30:28 / cg"
"Created: 22.3.1997 / 14:35:43 / cg"
! !
!JavaClass methodsFor:'java initialization'!
classInit
"call the classes JAVA clinit function"
|m|
(accessFlags bitAnd:A_INITIALIZED) ~~ 0 ifTrue:[^ self].
accessFlags := accessFlags bitOr:A_INITIALIZED.
superclass ~~ JavaObject ifTrue:[
superclass classInit
].
"/ "/ also, all referenced classes must be ...
"/ constantPool classReferencesDo:[:aClass |
"/ aClass classInit
"/ ].
m := self compiledMethodAt:#'<clinit>()V'.
m notNil ifTrue:[
"/'calling <clinit>() of ' print. self fullName printNL.
[
OrderOfClassInits notNil ifTrue:[
OrderOfClassInits add:self.
].
m
valueWithReceiver:self
arguments:#()
selector:#'<clinit>()V'
search:self class
sender:nil
] valueOnUnwindDo:[
accessFlags := accessFlags bitXor:A_INITIALIZED.
].
"/'calling <clinit>() done ' print. self fullName printNL.
] ifFalse:[
"/ self fullName print. ' has no clinit()' printNL.
].
"
JavaVM instructionTrace:true.
JavaVM callTrace:true.
(Java classNamed:'java.lang.String') classInit
(Java classNamed:'java.lang.System') classInit
(Java classNamed:'java/io/FileDescriptor') classInit
(Java classNamed:'java.util.Properties') classInit
"
"Modified: / 12-11-1998 / 15:41:11 / cg"
"Modified: / 11-12-2010 / 15:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-08-2011 / 19:37:33 / jv"
!
initializeStaticFields
staticFields isNil ifTrue:[^ self].
staticFields do:[:f |
|val type|
(val := f constantValue) isNil ifTrue:[
"/ careful: int/long etc. constants must be initialized
"/ with correct type.
type := f type.
type == #long ifTrue:[
val := 0.
] ifFalse:[type == #int ifTrue:[
val := 0.
] ifFalse:[type == #float ifTrue:[
val := 0.0 asShortFloat
] ifFalse:[type == #double ifTrue:[
val := 0.0
] ifFalse:[type == #byte ifTrue:[
val := 0.
] ifFalse:[type == #char ifTrue:[
val := 0.
] ifFalse:[type == #'unsigned short' ifTrue:[
val := 0.
] ifFalse:[type == #boolean ifTrue:[
val := 0.
]]]]]]]].
].
self instVarNamed:(f name) put:val.
].
! !
!JavaClass methodsFor:'java instance creation'!
initValueFor:instVarName
|idx field|
idx := fields findFirst:[:field | field name = instVarName].
idx == 0 ifTrue:[
superclass ~~ JavaObject ifTrue:[
^ superclass initValueFor:instVarName
].
self halt
] ifFalse:[
field := fields at:idx.
^ field initialValue
].
!
new
"create a new instance, preset its fields,
and call its JAVA init function"
|newJavaObject|
newJavaObject := self newCleared.
newJavaObject perform:#'<init>()V'.
^ newJavaObject
"
(Java classNamed:'java.lang.String') basicNew inspect
(Java classNamed:'java.lang.String') newCleared inspect
(Java classNamed:'java.lang.String') new inspect
"
"Modified: / 4.11.1998 / 18:04:34 / cg"
!
newCleared
"create a new cleared JAVA instance.
Its instVars are cleared to the corresponding typed values;
however, <init> is not invoked for it."
| newJavaObject
sz "{ Class: SmallInteger }" |
(accessFlags bitAnd: A_ABSTRACT_OR_INTERFACE) ~~ 0
ifTrue:
[ JavaVM throwInstantiationExceptionFor: self.
^ nil ].
newJavaObject := super basicNew.
initValues notNil
ifTrue:
[ sz := self instSize.
1 to: sz do: [:i | newJavaObject instVarAt: i put: (initValues at: i) ]. ].
^ newJavaObject
"
(Java classNamed:'java.lang.String') basicNew inspect
(Java classNamed:'java.lang.String') newCleared inspect
(Java classNamed:'java.lang.String') new inspect"
"Modified: / 13-11-1998 / 14:10:45 / cg"
"Modified: / 10-03-2011 / 22:38:40 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
newWith_String:argString
"create a new instance, preset its fields,
and call its JAVA init function passing a String arg"
|newJavaObject|
newJavaObject := self newCleared.
newJavaObject
perform:#'<init>(Ljava/lang/String;)V'
with:(Java as_String:argString).
^ newJavaObject
"
((Java classNamed:'java.lang.ArrayStoreException') newWith_String:'foo') inspect
"
"Modified: / 4.11.1998 / 18:04:34 / cg"
"Created: / 13.11.1998 / 14:17:01 / cg"
!
newWith_int:arg
"create a new instance, preset its fields,
and call its JAVA init function passing an int arg"
|newJavaObject|
newJavaObject := self newCleared.
newJavaObject perform:#'<init>(I)V' with:arg.
^ newJavaObject
"
((Java classNamed:'java.lang.Integer') newWith_int:123) inspect
"
"Modified: / 4.11.1998 / 18:04:34 / cg"
"Created: / 13.11.1998 / 14:17:01 / cg"
! !
!JavaClass methodsFor:'message sending'!
doesNotUnderstand:aMessage
"as a courtesy to the smalltalker, try to map static methods as
Smalltalk-class methods"
|r args numArgs methods javaMethod sel anyMethodsFound argType
argSignature newArgs oArgIdx nArgIdx canConvert
retVal|
args := aMessage arguments.
numArgs := args size.
sel := aMessage selector.
methods := JavaClass lookupMethods:sel numArgs:numArgs in:self static:true.
methods size == 1 ifTrue:[
javaMethod := methods first.
"/ there is only one - try that one.
] ifFalse:[
methods size > 1 ifTrue:[
"/ more than one - select the ones that could be used.
methods := methods select:[:aMethod |
|argSignature|
argSignature := aMethod argSignature.
(JavaClass canConvertArgsToJava:args asSpecifiedIn:argSignature)
].
methods size == 1 ifTrue:[
javaMethod := methods first.
]
]
].
javaMethod notNil ifTrue:[
(ArgumentConversionErrorSignal catch:[
args notNil ifTrue:[
args := JavaClass
convertArgsToJava:args
asSpecifiedIn:(javaMethod argSignature)
numArgs:numArgs.
].
]) ifFalse:[
retVal := javaMethod
valueWithReceiver:self "/ (javaMethod javaClass)
arguments:args
selector:(javaMethod selector)
search:self "/ (javaMethod javaClass class)
sender:nil.
^ JavaClass convertToSmalltalk:retVal type:(javaMethod returnType).
].
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:'no method for given argument(s)'
in:thisContext "sender"
].
anyMethodsFound := false.
"/ try all with that name (the number of args could be different ...
methods := JavaClass lookupMethods:sel numArgs:nil in:self static:true.
methods size > 0 ifTrue:[
anyMethodsFound := true.
numArgs > 0 ifTrue:[
methods do:[:methodToTry |
(ArgumentConversionErrorSignal catch:[
newArgs := JavaClass
convertArgsToJava:args
asSpecifiedIn:(methodToTry argSignature)
numArgs:methodToTry numArgs.
]) ifFalse:[
retVal := methodToTry
valueWithReceiver:self "/ (methodToTry javaClass)
arguments:newArgs
selector:(methodToTry selector)
search:self "/ (methodToTry javaClass class)
sender:nil.
^ JavaClass convertToSmalltalk:retVal type:(methodToTry returnType).
].
].
]
].
anyMethodsFound ifTrue:[
methods size == 1 ifTrue:[
javaMethod := methods first.
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:(sel , ' expects ' , javaMethod argSignature size printString , ' argument(s)')
in:thisContext "sender"
].
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:'no method for given argument count or type'
in:thisContext "sender"
].
^ super doesNotUnderstand:aMessage
"Modified: / 6.11.1998 / 00:57:22 / cg"
!
lookupMethodFor:selector
|method cls sel queue |
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
queue := OrderedCollection with: self.
[ queue isEmpty ] whileFalse:[
cls := queue removeFirst.
method := cls compiledMethodAt:sel.
method notNil ifTrue:[ ^ method ].
queue addAll: cls interfaces.
cls isInterface ifFalse:[
cls superclass ~~ JavaObject ifTrue:[queue add: cls superclass]
]
].
].
"/cls ifNotNil:[^super lookupMethodFor: selector].
^ nil
"Modified: / 10-08-2011 / 22:40:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
performStatic:selector
"send a static message, without args."
|javaMethod sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
javaMethod := methodDictionary at:sel.
javaMethod notNil ifTrue:[
javaMethod isStatic ifTrue:[
^ javaMethod
valueWithReceiver:self
arguments:#()
]
].
].
^ self doesNotUnderstand:(Message selector:selector)
"Modified: / 15.1.1998 / 00:31:27 / cg"
"Created: / 12.11.1998 / 16:29:20 / cg"
!
performStatic:selector with:arg
"send a static message, with one args."
|javaMethod sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
javaMethod := methodDictionary at:sel.
javaMethod notNil ifTrue:[
javaMethod isStatic ifTrue:[
^ javaMethod
valueWithReceiver:self
arguments:(Array with:arg)
selector:selector
search:nil
sender:nil
]
].
].
^ self doesNotUnderstand:(Message selector:selector argument:arg)
"Modified: / 15.1.1998 / 00:31:27 / cg"
"Created: / 10.12.1998 / 21:50:29 / cg"
! !
!JavaClass methodsFor:'misc ui support'!
iconInBrowserSymbol
<resource: #programImage>
^#javaClassBrowserIcon
"Created: / 20-12-2010 / 19:11:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaClass methodsFor:'printOut'!
printNameInHierarchy
"return my name as printed in the hierarchy"
^ self displayString
"Modified: 22.3.1997 / 14:16:55 / cg"
!
printOutOn:aStream
self warn:'printOut not yet supported'
"Created: 22.3.1997 / 14:36:12 / cg"
!
printOutProtocolOn:aStream
self warn:'printOut not yet supported'
"Created: 22.3.1997 / 14:36:28 / cg"
! !
!JavaClass methodsFor:'printing & storing'!
displayString
^ fullName copyReplaceAll:$/ with:$.
"/ ^ 'JAVA-' , name .
"/ ^ name , '(Java)' "/ 'JavaClass(' , name , ')'
"Created: / 15.4.1996 / 16:02:48 / cg"
"Modified: / 18.7.1998 / 22:56:30 / cg"
! !
!JavaClass methodsFor:'private accessing'!
addMethod:m name:name signature:signature
|sel|
sel := (name , signature) asSymbol.
self addSelector:sel withMethod:m.
^ self.
"/ selectorArray isNil ifTrue:[
"/ selectorArray := #().
"/ methodArray := #()
"/ ].
"/ selectorArray := selectorArray copyWith:(name , signature) asSymbol. "/ name.
"/"/ selectorArray := selectorArray copyWith:name asSymbol. "/ name.
"/ methodArray := methodArray copyWith:m
"Created: 15.4.1996 / 16:42:52 / cg"
!
addSelector:newSelector withMethod:newMethod
"redefined to not flush smalltalk caches and send NO smalltalk-class
change notification. Will eventually flush Java caches."
|nargs oldMethod|
oldMethod := self compiledMethodAt:newSelector.
(self primAddSelector:newSelector withMethod:newMethod) ifFalse:[^ false].
^ true
"Created: 20.1.1997 / 13:00:48 / cg"
!
setAccessFlags:flags
accessFlags := flags.
"Created: 15.4.1996 / 16:42:52 / cg"
!
setBinaryFilePath:aPathName
binaryFilePath := aPathName
!
setFields:f
|vals|
JavaClass setInstanceVariableStringFromFields:f in:self.
instSize := superclass instSize + f size.
fields := f.
f withIndexDo:[:field :index|
field setClass: self.
field setIndex: superclass instSize + index.
].
vals := self allInstVarNames
collect:[:nm |
self initValueFor:nm
].
vals isEmpty ifTrue:[
initValues := nil
] ifFalse:[
(vals detect:[:el | el notNil] ifNone:nil) isNil ifTrue:[
initValues := nil
] ifFalse:[
initValues := vals asArray
]
]
"Created: / 15-04-1996 / 16:42:52 / cg"
"Modified: / 06-11-1998 / 01:53:01 / cg"
"Modified: / 27-07-2011 / 09:26:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setFullName:aString
|nameComponents|
fullName := aString asSymbol.
"/ nameComponents := aString asCollectionOfSubstringsSeparatedBy:$/.
"/ name := nameComponents last asSymbol.
name := fullName.
"Created: / 15.4.1996 / 16:42:52 / cg"
"Modified: / 5.11.1998 / 19:14:39 / cg"
!
setInterfaces:i
i size > 0 ifTrue:[
interfaces := i
] ifFalse:[
interfaces := nil
]
"Modified: 7.4.1997 / 15:44:53 / cg"
!
setSourceFile:aFilename
sourceFile := aFilename.
"Created: 15.4.1996 / 16:42:52 / cg"
!
setStaticFields:f
JavaClass setInstanceVariableStringFromFields:f in:self class.
staticFields := f.
"Modified: / 17-08-2011 / 09:26:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setSuperclass:aClass
|iVars numIvars|
aClass isNil ifTrue:[
super setSuperclass:JavaObject
] ifFalse:[
(aClass isMemberOf:JavaUnresolvedClassConstant) ifTrue:[
self halt.
].
super setSuperclass:aClass.
].
iVars := self instVarNames.
((numIvars := iVars size) > 0) ifTrue:[
(superclass notNil and:[(superclass isMemberOf:JavaUnresolvedClassConstant) not]) ifTrue:[
instSize := superclass instSize + numIvars
] ifFalse:[
instSize := numIvars
]
].
"Created: 15.4.1996 / 16:42:52 / cg"
"Modified: 22.8.1997 / 15:06:45 / cg"
! !
!JavaClass methodsFor:'private-changes management'!
writingChangeWithTimeStamp:doStampIt do:aBlock
"No changes for Java classes now"
"Created: / 14-12-2010 / 18:07:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaClass methodsFor:'queries'!
canBeSubclassed
"return true, if its allowed to create subclasses of the receiver."
self isFinal ifTrue:[^ false].
self isInterface ifTrue:[^ false].
^ true
"Created: / 5.11.1998 / 23:04:50 / cg"
!
containsMethodsAnnotatedWith:aJavaTypeName
| methods |
methods := self selectMethodsAnnotatedWith:aJavaTypeName.
methods size > 0 ifTrue:[ ^ true ].
(self name ~= #'java/lang/Object')
ifTrue:[ ^ superclass containsMethodsAnnotatedWith:aJavaTypeName. ].
^ false.
"Created: / 02-03-2011 / 23:01:14 / Marcel Hlopko <hlopik@gmail.com>"
!
hasInterface:aJavaInterface
"return true, if I respond to all methods as
required by the argument, an aJavaInterface"
interfaces size > 0 ifTrue:[
self interfaces do:[:if |
aJavaInterface == if ifTrue:[
^ true
].
]
].
superclass isJavaClass ifTrue:[
^ superclass hasInterface:aJavaInterface
].
^ false.
"/ aJavaInterface methodDictionary keysAndValuesDo:[:sel :mthd |
"/ (self canUnderstand:sel) ifFalse:[
"/ ^ false.
"/ ]
"/ ].
^ true
"Modified: / 28.1.1998 / 01:46:16 / cg"
!
isAnonymous
| i |
i := name lastIndexOf: $$.
i ~~ 0 ifTrue:[
i + 1 to: name size do:[:i|
(name at:i) isDigit ifFalse:[^false].
].
^true
].
^false
"
(Java at:'java.io.Console') isAnonymous
(Java at:'java.io.Console$1') isAnonymous
(Java at:'java.io.Console$1$1') isAnonymous
(Java at:'sun.misc.Launcher$ExtClassLoader') isAnonymous
"
"Created: / 18-03-1997 / 17:48:01 / cg"
"Created: / 07-08-2011 / 15:50:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isJavaArrayClass
^false
"Created: / 05-02-2011 / 22:20:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isJavaClass
^ self ~~ JavaClass
"Created: 18.3.1997 / 17:48:01 / cg"
!
isJavaClassType
^self isInterface not
"
(Java classForName:'java.lang.Class') isJavaClassType
"
"Created: / 11-02-2011 / 08:09:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isJavaInterfaceType
^self isInterface
"
(Java classForName:'java.lang.Class') isJavaInterfaceType
"
"Created: / 11-02-2011 / 08:09:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isJavaMethodRef
^ false
"Created: / 9.11.1999 / 15:42:10 / cg"
!
isJavaPrimitiveType
^false
"
(Java classForName:'java.lang.Class') isJavaPrimitiveType
ByteArray isJavaPrimitiveType
"
"Created: / 21-12-2010 / 23:03:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isJavaReferenceType
^true
"
(Java classForName:'java.lang.Class') isJavaReferenceType
"
"Created: / 20-12-2010 / 21:54:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isJavaType
^true
"
(Java classForName:'java.lang.Class') isJavaType
"
"Created: / 20-12-2010 / 21:53:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isUnresolved
"return true, if the receiver is unresolved;
javaClasses are never; JavaUnresolvedClasses are always"
^ false
"Modified: / 07-05-1998 / 12:23:14 / cg"
"Created: / 06-03-2011 / 22:57:07 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
nameInBrowser
"return a nameString as shown in browsers"
^ self name copyReplaceAll:$/ with:$.
!
nameSpacePath
|parts s|
parts := self fullName asCollectionOfSubstringsSeparatedBy:$/.
s := '' writeStream.
s nextPutAll:'JAVA'.
parts from:1 to:(parts size - 1) do:[:aPart |
s nextPutAll:'::'.
s nextPutAll:aPart
].
^ s contents
"
JAVA::java::lang::Object fullName
JAVA::java::lang::Object nameSpacePath
JAVA::java::lang::Object name
"
"Modified: / 19.10.1998 / 20:07:24 / cg"
!
selectMethodsAnnotatedWith:aJavaTypeName
^ self methodDictionary values select:
[:method |
(method annotations
ifNotNil:[ method annotations runtimeVisible at:aJavaTypeName ifAbsent:nil ])
isNil not ]
"Created: / 02-03-2011 / 23:06:42 / Marcel Hlopko <hlopik@gmail.com>"
!
supportsMethodCategories
^ self isJavaClass not
"Created: / 30.7.1997 / 14:58:58 / cg"
"Modified: / 7.5.1998 / 12:25:54 / cg"
!
typeName
^ 'L' , self fullName , ';'.
"
(Java at:'java.util.Stack') typeName"
"Modified: / 10-02-1998 / 17:13:26 / cg"
"Modified: / 02-03-2011 / 22:48:40 / Marcel Hlopko <hlopik@gmail.com>"
! !
!JavaClass methodsFor:'queries-protocol'!
equalsOrIsSubclassOf: aJavaClass
self = aJavaClass ifTrue: [^true].
^ self isSubclassOf:aJavaClass.
"Created: / 30-05-2011 / 23:07:18 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
includesBehavior: aClass
^(aClass isJavaClass not or:[aClass isInterface not])
ifTrue:[super includesBehavior: aClass]
ifFalse:[self == aClass or:[self allInterfaces includes: aClass]].
"Created: / 05-02-2011 / 23:44:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 11-02-2011 / 09:12:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isSubclassOf: aJavaClass
|tmpClass|
tmpClass := self superclass.
[tmpClass isJavaClass] whileTrue: [tmpClass = aJavaClass ifTrue:[^true]. tmpClass := tmpClass superclass].
^false.
"Created: / 13-04-2011 / 23:18:03 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!JavaClass methodsFor:'reflection'!
lookupFieldByNameAndType: aJavaNameAndType
| field cls |
cls := self.
[ cls ~= JavaObject ] whileTrue: [
field := cls fields detect:
[:each |
each name = aJavaNameAndType name
"and: [ each signatureWithoutTypeVariables = aJavaNameAndType descriptor ]"]
ifNone:[nil].
field ifNotNil:[^field].
cls := cls superclass.
].
self breakPoint: #jv.
^nil
"Created: / 11-04-2011 / 21:27:08 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
"Modified: / 04-06-2011 / 17:06:14 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
"Modified: / 13-08-2011 / 00:46:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lookupMethodByNameAndType: aJavaNameAndType
^ self lookupMethodFor: aJavaNameAndType selector.
"Created: / 11-04-2011 / 21:28:34 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
lookupStaticFieldByNameAndType: aJavaNameAndType
| field cls |
cls := self.
[ cls ~= JavaObject ] whileTrue: [
field := cls staticFields detect:
[:each |
each name = aJavaNameAndType name
"and: [ each signature = aJavaNameAndType descriptor ]"]
ifNone:[nil].
field ifNotNil:[^field].
cls := cls superclass.
].
self breakPoint: #jv.
^nil
"Created: / 11-04-2011 / 21:27:08 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
"Modified: / 04-06-2011 / 17:06:20 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
"Modified: / 13-08-2011 / 00:46:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
lookupStaticMethodByNameAndType: aJavaNameAndType
^ self lookupMethodFor: aJavaNameAndType selector.
"Created: / 28-04-2011 / 22:50:31 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!JavaClass methodsFor:'special'!
asClassPointerRef
"/ self halt.
^ self
"Created: / 10.11.1998 / 02:07:01 / cg"
"Modified: / 8.1.1999 / 14:11:26 / cg"
!
deinit
accessFlags := accessFlags bitClear: A_INITIALIZED.
"Created: / 25-10-2010 / 12:28:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
deref
^ self
"Created: / 10.11.1998 / 02:08:06 / cg"
!
javaArrayClass
"/ self halt.
"/ ^ Array
^ JavaVM javaArrayClassFor:self
"Created: / 10-11-1998 / 02:07:32 / cg"
"Modified: / 08-01-1999 / 14:11:34 / cg"
"Modified: / 19-12-2010 / 16:13:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateClassRefsFrom:oldClass to:newClass
self == oldClass ifTrue:[
self makeObsolete.
^ self
].
constantPool updateClassRefsFrom:oldClass to:newClass.
interfaces notNil ifTrue:[
interfaces := interfaces collect:[:anInterface |
anInterface == oldClass ifTrue:[
newClass isNil ifTrue:[
nil "/ replace by an unresolvedInterface
] ifFalse:[
newClass
]
] ifFalse:[
anInterface
]
]
]
"Modified: / 4.2.1998 / 22:08:19 / cg"
! !
!JavaClass methodsFor:'support - refactorings'!
directlyDefinesMethod: aSelector
^self methodDictionary includes: aSelector.
"Created: / 16-03-2011 / 14:21:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
metaclass
^self class
"Created: / 16-03-2011 / 14:22:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaClass methodsFor:'support - sUnit'!
asTestCase
self isTestletLike
ifTrue: [^ TestletTestCaseProxy for: self ].
^ JUnitTestCaseProxy for: self.
"Created: / 04-03-2011 / 08:20:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-04-2011 / 17:52:13 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
"Modified: / 07-05-2011 / 18:59:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
asTestlet
^ TestletTestCaseProxy for: self
"Created: / 29-04-2011 / 16:53:18 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
buildSuite
self isTestletLike ifTrue: [ ^(TestletTestCaseProxy for: self) buildSuite ].
^ (JUnitTestCaseProxy for: self) buildSuite
"Created: / 29-05-2011 / 22:45:17 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
isTestCaseLike
| junit_framework_TestCase org_junit_Test |
"try JUnit 4.x"
[ org_junit_Test := JavaVM classForName: 'org.junit.Test' ] on: Error
do:
[ "nothing"
].
(org_junit_Test notNil
and: [ self containsMethodsAnnotatedWith: org_junit_Test typeName ])
ifTrue: [ ^ true ].
"Try jUnit 3.x"
[ junit_framework_TestCase := JavaVM
classForName: 'junit.framework.TestCase' ] on: Error
do:
[ "nothing"
].
junit_framework_TestCase ifNotNil:
[ self == org_junit_Test ifTrue: [ ^ false ].
(self includesBehavior: junit_framework_TestCase) ifTrue: [ ^ true ] ].
^ self isTestletLike.
"
JAVA::java::lang::Object isTestCaseLike
JAVA::stx::libjava::tests::junit::JUnit3Tests isTestCaseLike"
"Created: / 28-02-2011 / 21:31:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 02-03-2011 / 23:08:02 / Marcel Hlopko <hlopik@gmail.com>"
"Modified: / 06-03-2011 / 14:27:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-05-2011 / 22:48:07 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
isTestSelector: selector
"Hack, you're right, blame on me"
| junit_framework_TestCase m |
((selector == #'test(Lgnu/testlet/TestHarness;)V')
and:[self ~~ (Java at:'gnu.testlet.Testlet')])
ifTrue:[^true].
junit_framework_TestCase := Java at:'junit.framework.TestCase'.
(junit_framework_TestCase notNil and:
[self includesBehavior:junit_framework_TestCase])
ifTrue:[^selector startsWith: 'test'].
m := self lookupSelector: selector.
"Sorry fo that, but I need this method to be fast"
^m annotations runtimeVisible includesKey: 'Lorg/junit/Test;'.
"Modified: / 02-03-2011 / 23:08:02 / Marcel Hlopko <hlopik@gmail.com>"
"Created: / 04-03-2011 / 07:07:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isTestletLike
| testlet |
[ testlet := JavaVM classForName: 'gnu.testlet.Testlet' ] on: Error
do:
[ "nothing"
].
testlet ifNil:[^ false].
self == testlet ifTrue: [ ^ false ].
(self includesBehavior: testlet) ifTrue: [ ^ true ].
^ false.
"Modified: / 02-03-2011 / 23:08:02 / Marcel Hlopko <hlopik@gmail.com>"
"Modified: / 06-03-2011 / 14:27:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 29-04-2011 / 17:02:22 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !
!JavaClass class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libjava/JavaClass.st,v 1.130 2011-11-24 11:55:09 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libjava/JavaClass.st,v 1.130 2011-11-24 11:55:09 cg Exp $'
!
version_SVN
^ '§Id: JavaClass.st,v 1.127 2011/08/18 18:42:48 vrany Exp §'
! !
JavaClass initialize!