--- a/JavaClass.st Thu Sep 23 13:52:13 2010 +0000
+++ b/JavaClass.st Fri Aug 19 08:58:19 2011 +0000
@@ -1,6 +1,10 @@
"
- COPYRIGHT (c) 1997 by eXept Software AG
- All Rights Reserved
+ 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
+
+ Parts of the code written by Claus Gittinger are under following
+ license:
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -8,12 +12,38 @@
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
+
+ Parts of the code written at SWING Reasearch Group [1] are MIT licensed:
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation
+ files (the 'Software'), to deal in the Software without
+ restriction, including without limitation the rights to use,
+ copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following
+ conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.
+
+ [1] Code written at SWING Research Group contain a signature
+ of one of the above copright owners.
"
"{ Package: 'stx:libjava' }"
JavaBehavior subclass:#JavaClass
instanceVariableNames:'classLoader fullName sourceFile binaryFilePath fields initValues
- staticFields'
+ staticFields annotations protectionDomain signatureJ'
classVariableNames:'ArgumentConversionErrorSignal OrderOfClassInits'
poolDictionaries:''
category:'Languages-Java-Classes'
@@ -23,8 +53,12 @@
copyright
"
- COPYRIGHT (c) 1997 by eXept Software AG
- All Rights Reserved
+ 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
+
+ Parts of the code written by Claus Gittinger are under following
+ license:
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -32,6 +66,33 @@
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
+
+ Parts of the code written at SWING Reasearch Group [1] are MIT licensed:
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation
+ files (the 'Software'), to deal in the Software without
+ restriction, including without limitation the rights to use,
+ copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following
+ conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.
+
+ [1] Code written at SWING Research Group contain a signature
+ of one of the above copright owners.
+
"
!
@@ -79,8 +140,9 @@
cls := meta new.
cls setSuperclass:JavaObject.
cls instSize:0.
- cls setName:('JAVA::' , aString).
+ cls setName:('JAVA::' , aString).
cls flags:0.
+
cls setAccessFlags:0.
"/ cls setClassVariableString:''.
cls setInstanceVariableString:''.
@@ -132,8 +194,9 @@
^ cls
- "Created: / 15.4.1996 / 15:52:55 / cg"
- "Modified: / 3.1.1998 / 22:32:25 / cg"
+ "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
@@ -142,6 +205,15 @@
"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
@@ -196,17 +268,17 @@
"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
- ]
-
- "Modified: / 5.11.1998 / 18:43:33 / cg"
- "Created: / 6.11.1998 / 00:45:13 / cg"
+ 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
@@ -216,157 +288,172 @@
|expectedCls f failValue|
type == #boolean ifTrue:[
- arg == true ifTrue:[
- ^ 1
- ].
- arg == false ifTrue:[
- ^ 0
- ].
- ^ failBlock value:('cannot convert argument to ' , type) value:0
+ 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 and:16r7FFFFFFF) ifTrue:[
- ^ arg
- ].
- ^ failBlock value:('integer range; cannot convert argument to ' , type) value:0.
- ].
- ^ failBlock value:('cannot convert argument to ' , type) value:0
+ 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:-16r800000000000000 and:16r7FFFFFFFFFFFFFFF) ifTrue:[
- ^ arg
- ].
- ^ failBlock value:('integer range; cannot convert argument to ' , type) value:0
- ].
- ^ failBlock value:('cannot convert argument to ' , type) value:0
+ 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.
+ 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).
+ 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.
+ ^ 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).
+ 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.
+ ^ 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.
+ 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
+ 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:''
+ 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:''
+ (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:''
+ (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:''
+ (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:''
+ (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:''
+ (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
+ "/ matches any
+ ^ arg
].
(type = 'java.lang.String') ifTrue:[
- arg isString ifTrue:[
- ^ Java as_String:arg
- ].
- failValue := ''
- ].
- expectedCls := Java classForName:type.
- (arg isKindOf:expectedCls) ifTrue:[
- "/ matches class and subclasses
- ^ arg
+ arg isString ifTrue:[
+ ^ Java as_String:arg
+ ].
+ failValue := ''
].
arg isNil ifTrue:[
- "/ matches any
- ^ arg
+ "/ matches any
+ ^ arg
].
self halt.
^ failBlock value:('cannot convert argument to ' , type) value:failValue
- "Created: / 6.11.1998 / 00:46:19 / cg"
- "Modified: / 6.11.2001 / 13:28:29 / cg"
+ "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
+ jObj == 0 ifTrue:[
+ ^ false
+ ].
+ ^ true
].
type == #void ifTrue:[
- ^ nil
+ ^ nil
].
(type = 'java.lang.String') ifTrue:[
- ^ Java as_ST_String:jObj
+ ^ Java as_ST_String:jObj
].
"/ (type = 'java.lang.Float') ifTrue:[
@@ -377,15 +464,17 @@
"/ ].
(type == #char) ifTrue:[
- jObj isInteger ifTrue:[
- ^ Character value:jObj
- ].
+ jObj isInteger ifTrue:[
+ ^ Character value:jObj
+ ].
].
^ jObj
- "Created: / 6.11.1998 / 00:49:53 / cg"
- "Modified: / 11.11.1998 / 02:08:11 / cg"
+ "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
@@ -501,6 +590,19 @@
!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
@@ -534,6 +636,30 @@
!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
!
@@ -603,6 +729,14 @@
^ 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
!
@@ -612,20 +746,28 @@
!
interfaces
- interfaces notNil ifTrue:[
- interfaces := interfaces collect:[:clsRef |
- clsRef isUnresolved ifTrue:[
- clsRef preResolve
- ] ifFalse:[
- clsRef
- ]
- ].
- ].
- ^ 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
@@ -662,6 +804,26 @@
"
!
+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
@@ -717,6 +879,38 @@
"
!
+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
@@ -737,6 +931,20 @@
^ 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 |
@@ -761,6 +969,14 @@
"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
@@ -820,40 +1036,6 @@
^ super browserClass.
"Modified: / 14.10.1998 / 15:28:38 / cg"
-!
-
-compilerClass
- "return the compiler to use for this class -
- this can be redefined in special classes, to compile classes with
- Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
-
- ^ JavaCompiler ? Compiler
-!
-
-evaluatorClass
- "return the compiler to use for expression evaluation for this class -
- this can be redefined in special classes, to evaluate expressions with
- Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
-
- ^ JavaParser ? Parser.
-
-!
-
-parserClass
- "return the parser to use for parsing this class -
- this can be redefined in special classes, to parse classes with
- Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
-
- ^ JavaParser ? Parser.
-
-!
-
-syntaxHighlighterClass
- "return the class to use for syntaxHighlighting (prettyPrinting) this class -
- this can be redefined in special classes, to highlight classes with
- Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
-
- ^ JavaSyntaxHighlighter "/ ? SyntaxHighlighter
! !
!JavaClass methodsFor:'compiling'!
@@ -1028,14 +1210,14 @@
classInit
"call the classes JAVA clinit function"
- |m|
+ |m|
(accessFlags bitAnd:A_INITIALIZED) ~~ 0 ifTrue:[^ self].
accessFlags := accessFlags bitOr:A_INITIALIZED.
superclass ~~ JavaObject ifTrue:[
- superclass classInit
+ superclass classInit
].
"/ "/ also, all referenced classes must be ...
"/ constantPool classReferencesDo:[:aClass |
@@ -1044,25 +1226,27 @@
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>() 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.
@@ -1074,7 +1258,9 @@
(Java classNamed:'java.util.Properties') classInit
"
- "Modified: / 12.11.1998 / 15:41:11 / cg"
+ "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
@@ -1149,31 +1335,28 @@
"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
+ 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)
- ].
- ].
-
+ 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"
+ (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
@@ -1317,19 +1500,25 @@
!
lookupMethodFor:selector
- |method cls sel|
+ |method cls sel queue |
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
- cls := self.
- [cls notNil] whileTrue:[
- method := cls compiledMethodAt:sel.
- method notNil ifTrue:[ ^ method ].
- cls := cls superclass.
- ].
+ 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
@@ -1381,6 +1570,17 @@
"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
@@ -1461,36 +1661,36 @@
binaryFilePath := aPathName
!
-setConstantPool:anArray
- constantPool := anArray.
-
- "Created: 15.4.1996 / 16:42:52 / cg"
-!
-
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
- ].
+ collect:[:nm |
+ self initValueFor:nm
+ ].
vals isEmpty ifTrue:[
- initValues := nil
+ initValues := nil
] ifFalse:[
- (vals detect:[:el | el notNil] ifNone:nil) isNil ifTrue:[
- initValues := nil
- ] ifFalse:[
- initValues := vals asArray
- ]
+ (vals detect:[:el | el notNil] ifNone:nil) isNil ifTrue:[
+ initValues := nil
+ ] ifFalse:[
+ initValues := vals asArray
+ ]
]
- "Created: / 15.4.1996 / 16:42:52 / cg"
- "Modified: / 6.11.1998 / 01:53:01 / cg"
+ "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
@@ -1526,7 +1726,7 @@
staticFields := f.
-
+ "Modified: / 17-08-2011 / 09:26:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setSuperclass:aClass
@@ -1554,6 +1754,15 @@
"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
@@ -1566,6 +1775,18 @@
"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"
@@ -1593,25 +1814,113 @@
!
+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: / 7.5.1998 / 12:23:14 / cg"
+ "Modified: / 07-05-1998 / 12:23:14 / cg"
+ "Created: / 06-03-2011 / 22:57:07 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!
nameInBrowser
@@ -1641,6 +1950,16 @@
"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
@@ -1649,25 +1968,104 @@
!
typeName
- ^ 'L' , self fullName
+ ^ 'L' , self fullName , ';'.
"
- (Java at:'java.util.Stack') typeName
- "
-
- "Modified: / 10.2.1998 / 17:13:26 / cg"
+ (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'!
-arrayClass
-"/ self halt.
- ^ Array
-
- "Created: / 10.11.1998 / 02:07:32 / cg"
- "Modified: / 8.1.1999 / 14:11:34 / cg"
-!
-
asClassPointerRef
"/ self halt.
^ self
@@ -1676,12 +2074,30 @@
"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.
@@ -1706,8 +2122,130 @@
"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
- ^ '$Id$'
+ ^ '$Id: JavaClass.st,v 1.127 2011/08/18 18:42:48 vrany Exp $'
+!
+
+version_SVN
+ ^ '$Id: JavaClass.st,v 1.127 2011/08/18 18:42:48 vrany Exp $'
! !
+
+JavaClass initialize!
\ No newline at end of file