added moo_iskindof().
changed isKindOf: to utilize a new primitive _is_kind_of. marked BlockContext and MethodContext to be #final and #limited
This commit is contained in:
parent
e38a4f1f20
commit
303b49270d
@ -215,10 +215,15 @@ extend Apex
|
||||
{
|
||||
| c |
|
||||
c := self superclass.
|
||||
[c notNil] whileTrue: [
|
||||
(* [c notNil] whileTrue: [
|
||||
[ c == aClass ] ifTrue: [^true].
|
||||
c := c superclass.
|
||||
].
|
||||
]. *)
|
||||
while (c notNil)
|
||||
{
|
||||
if (c == aClass) { ^true }.
|
||||
c := c superclass.
|
||||
}.
|
||||
^false
|
||||
}
|
||||
|
||||
@ -233,6 +238,7 @@ extend Apex
|
||||
|
||||
method(#class) isKindOf: aClass
|
||||
{
|
||||
<primitive: #_is_kind_of>
|
||||
^(self isMemberOf: aClass) or: [self inheritsFrom: aClass].
|
||||
}
|
||||
|
||||
@ -243,6 +249,7 @@ extend Apex
|
||||
|
||||
method isKindOf: aClass
|
||||
{
|
||||
<primitive: #_is_kind_of>
|
||||
^(self isMemberOf: aClass) or: [self class inheritsFrom: aClass].
|
||||
}
|
||||
|
||||
|
@ -42,7 +42,7 @@ block context...
|
||||
---------------------------------- *)
|
||||
}
|
||||
|
||||
class(#pointer) MethodContext(Context)
|
||||
class(#pointer,#final,#limited) MethodContext(Context)
|
||||
{
|
||||
var method, receiver, home, origin.
|
||||
|
||||
@ -99,7 +99,7 @@ class(#pointer) MethodContext(Context)
|
||||
}
|
||||
}
|
||||
|
||||
class(#pointer) BlockContext(Context)
|
||||
class(#pointer,#final,#limited) BlockContext(Context)
|
||||
{
|
||||
var nargs, source, home, origin.
|
||||
|
||||
|
@ -94,12 +94,14 @@ TODO: timed wait...
|
||||
}
|
||||
*)
|
||||
|
||||
(* TODO: MIGRATE TO MUTEX...
|
||||
method critical: aBlock
|
||||
{
|
||||
self wait.
|
||||
^aBlock ensure: [ self signal ]
|
||||
}
|
||||
}*)
|
||||
|
||||
|
||||
## ==================================================================
|
||||
|
||||
method heapIndex
|
||||
@ -133,6 +135,26 @@ TODO: timed wait...
|
||||
}
|
||||
}
|
||||
|
||||
class Mutex(Semaphore)
|
||||
{
|
||||
method(#class) new
|
||||
{
|
||||
| s |
|
||||
s := super new.
|
||||
s signal.
|
||||
^s.
|
||||
}
|
||||
|
||||
method lock { ^self wait }
|
||||
method unlock { ^self signal }
|
||||
|
||||
method critical: block
|
||||
{
|
||||
self wait.
|
||||
^block ensure: [ self signal ]
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
(*
|
||||
xxx := Semaphore new.
|
||||
|
@ -1,5 +1,7 @@
|
||||
## TODO: use this file as a regress testing source.
|
||||
## rename it to test-001.moo and use it as a test case file.
|
||||
##
|
||||
## TEST CASES for namespacing
|
||||
##
|
||||
|
||||
#include 'Moo.moo'.
|
||||
|
||||
|
||||
|
@ -1,3 +1,6 @@
|
||||
##
|
||||
## TEST CASES for basic methods
|
||||
##
|
||||
|
||||
#include 'Moo.moo'.
|
||||
|
||||
@ -50,8 +53,30 @@ class MyObject(TestObject)
|
||||
|
||||
method(#class) main
|
||||
{
|
||||
'START OF MAIN' dump.
|
||||
'EDN OF MAIN' dump.
|
||||
}
|
||||
| tc limit |
|
||||
|
||||
tc := %(
|
||||
## 0 - 4
|
||||
[(Object isKindOf: Class) == true],
|
||||
[(Object isKindOf: Apex) == true],
|
||||
[(Class isKindOf: Class) == true],
|
||||
[(Class isKindOf: Apex) == true],
|
||||
[(Class isKindOf: Object) == false],
|
||||
|
||||
[(Apex isKindOf: Class) == true],
|
||||
[(SmallInteger isKindOf: Integer) == false],
|
||||
[(10 isKindOf: Integer) == true],
|
||||
|
||||
[(Apex isMemberOf: Class) == true],
|
||||
[(Class isMemberOf: Class) == true]
|
||||
).
|
||||
|
||||
limit := tc size.
|
||||
|
||||
0 priorTo: limit by: 1 do: [ :idx |
|
||||
| tb |
|
||||
tb := tc at: idx.
|
||||
System log(System.Log.INFO, idx asString, (if (tb value) { ' PASS' } else { ' FAIL' }), S'\n').
|
||||
]
|
||||
}
|
||||
}
|
||||
|
@ -2098,6 +2098,27 @@ static moo_pfrc_t pf_hash (moo_t* moo, moo_ooi_t nargs)
|
||||
return MOO_PF_SUCCESS;
|
||||
}
|
||||
|
||||
static moo_pfrc_t pf_is_kind_of (moo_t* moo, moo_ooi_t nargs)
|
||||
{
|
||||
moo_oop_t rcv, _class;
|
||||
|
||||
rcv = MOO_STACK_GETRCV(moo, nargs);
|
||||
_class = MOO_STACK_GETARG(moo, nargs, 0);
|
||||
|
||||
MOO_PF_CHECK_ARGS (moo, nargs, MOO_CLASSOF(moo, _class) == moo->_class);
|
||||
|
||||
if (moo_iskindof(moo, rcv, (moo_oop_class_t)_class))
|
||||
{
|
||||
MOO_STACK_SETRET (moo, nargs, moo->_true);
|
||||
}
|
||||
else
|
||||
{
|
||||
MOO_STACK_SETRET (moo, nargs, moo->_false);
|
||||
}
|
||||
|
||||
return MOO_PF_SUCCESS;
|
||||
}
|
||||
|
||||
static moo_pfrc_t pf_responds_to (moo_t* moo, moo_ooi_t nargs)
|
||||
{
|
||||
moo_oop_t rcv, selector;
|
||||
@ -4135,6 +4156,7 @@ static pf_t pftab[] =
|
||||
|
||||
{ "_hash", { pf_hash, 0, 0 } },
|
||||
|
||||
{ "_is_kind_of", { pf_is_kind_of, 1, 1, } },
|
||||
{ "_responds_to", { pf_responds_to, 1, 1 } },
|
||||
{ "_perform", { pf_perform, 1, MA } },
|
||||
|
||||
|
@ -224,7 +224,7 @@ static kernel_class_info_t kernel_classes[] =
|
||||
|
||||
{ 13,
|
||||
{ 'M','e','t','h','o','d','C','o','n','t','e','x','t' },
|
||||
0,
|
||||
MOO_CLASS_SELFSPEC_FLAG_FINAL | MOO_CLASS_SELFSPEC_FLAG_LIMITED,
|
||||
MOO_CONTEXT_NAMED_INSTVARS,
|
||||
MOO_CLASS_SPEC_FLAG_INDEXED,
|
||||
MOO_OBJ_TYPE_OOP,
|
||||
@ -232,7 +232,7 @@ static kernel_class_info_t kernel_classes[] =
|
||||
|
||||
{ 12,
|
||||
{ 'B','l','o','c','k','C','o','n','t','e','x','t' },
|
||||
0,
|
||||
MOO_CLASS_SELFSPEC_FLAG_FINAL | MOO_CLASS_SELFSPEC_FLAG_LIMITED,
|
||||
MOO_CONTEXT_NAMED_INSTVARS,
|
||||
MOO_CLASS_SPEC_FLAG_INDEXED,
|
||||
MOO_OBJ_TYPE_OOP,
|
||||
|
@ -973,3 +973,27 @@ moo_oop_t moo_findclass (moo_t* moo, moo_oop_nsdic_t nsdic, const moo_ooch_t* na
|
||||
|
||||
return ass->value;
|
||||
}
|
||||
|
||||
int moo_iskindof (moo_t* moo, moo_oop_t obj, moo_oop_class_t _class)
|
||||
{
|
||||
moo_oop_class_t c;
|
||||
|
||||
c = MOO_CLASSOF(moo,obj); /* c := self class */
|
||||
if (c == moo->_class)
|
||||
{
|
||||
/* object is a class */
|
||||
if (_class == moo->_class) return 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
if (c == _class) return 1;
|
||||
}
|
||||
|
||||
c = (moo_oop_class_t)c->superclass;
|
||||
while ((moo_oop_t)c != moo->_nil)
|
||||
{
|
||||
if (c == _class) return 1;
|
||||
c = (moo_oop_class_t)c->superclass;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
@ -1729,6 +1729,12 @@ MOO_EXPORT moo_oop_t moo_findclass (
|
||||
const moo_ooch_t* name
|
||||
);
|
||||
|
||||
MOO_EXPORT int moo_iskindof (
|
||||
moo_t* moo,
|
||||
moo_oop_t obj,
|
||||
moo_oop_class_t _class
|
||||
);
|
||||
|
||||
/* =========================================================================
|
||||
* TRAILER MANAGEMENT
|
||||
* ========================================================================= */
|
||||
|
Loading…
Reference in New Issue
Block a user