#!perl
sub
new {
my
$pkg
=
shift
;
$pkg
=
ref
$pkg
||
$pkg
;
return
bless
{},
$pkg
;
}
my
$rt1
= JSPL::Runtime->new();
{
my
$cx1
=
$rt1
->create_context();
$cx1
->bind_class(
name
=>
"Foo"
,
constructor
=>
sub
{
my
$pkg
=
shift
;
is(
$pkg
,
"Foo"
,
"package is Foo in Foo constructor"
);
return
Foo->new();
}
);
my
$o
=
$cx1
->
eval
(
"new Foo();"
);
isa_ok(
$o
,
"Foo"
,
"new Foo(); returns instanceof Foo"
);
$cx1
->bind_class(
name
=>
"Bar"
,
constructor
=>
sub
{
my
$pkg
=
shift
;
is(
$pkg
,
"Foo"
,
"package is Foo in Bar constructor"
);
return
$pkg
->new();
},
package
=>
"Foo"
,
);
my
$p
=
$cx1
->
eval
(
"new Bar()"
);
isa_ok(
$p
,
"Foo"
,
"new Bar() returns instanceof Foo"
);
}
{
my
$cx1
=
$rt1
->create_context();
$cx1
->bind_class(
name
=>
"Foo"
);
$cx1
->bind_class(
name
=>
"Baz"
,
package
=>
"Foo"
);
my
$o
=
$cx1
->
eval
(
"new Foo();"
);
isa_ok(
$o
,
"Foo"
,
"new Foo() returns instanceof Foo"
);
$o
=
$cx1
->
eval
(
"new Baz();"
);
isa_ok(
$o
,
"Foo"
,
"new Baz() returns instanceof Foo"
);
}
{
my
$Foo_object_method
= 0;
sub
object_method {
my
$self
=
shift
;
isa_ok(
$self
,
"Foo"
,
"self is Foo in object_method"
);
is(
$_
[0],
scalar
@_
,
"1 arg in object_method"
);
$Foo_object_method
++;
}
my
$Foo_class_method
= 0;
sub
class_method {
my
$self
=
shift
;
is(
$self
,
"Foo"
,
"self is Foo in class_method"
);
is(
$_
[0],
scalar
@_
,
"1 arg in class_method"
);
$Foo_class_method
++;
}
my
$cx1
=
$rt1
->create_context();
$cx1
->bind_class(
name
=>
"Foo"
,
constructor
=> \
&Foo::new
,
fs
=> {
object_method
=> \
&Foo::object_method
},
static_fs
=> {
class_method
=> \
&Foo::class_method
, },
package
=>
"Foo"
,
);
$cx1
->
eval
(
"o = new Foo(); o.object_method(1)"
);
if
($@ ||
$Foo_object_method
== 0) {
ok(0,
"self is Foo in object_method"
);
ok(0,
"1 arg in object_method"
);
}
$cx1
->
eval
(
"Foo.class_method(1);"
);
if
($@ ||
$Foo_class_method
== 0) {
ok(0,
"self is Foo in class_method"
);
ok(0,
"1 arg in class_method"
);
}
}
{
sub
fone {
is(
$_
[1], 1,
"called fone"
);
}
sub
ftwo {
is(
$_
[1], 2,
"called ftwo"
);
}
my
$cx1
=
$rt1
->create_context();
$cx1
->bind_class(
name
=>
"Foo"
,
constructor
=>
"new"
,
fs
=> [
qw(fone ftwo)
],
);
$cx1
->
eval
(
"o = new Foo(); o.fone(1); o.ftwo(2)"
);
if
($@) {
ok(0,
"called fone"
);
ok(0,
"called ftwo"
);
}
}
{
my
$x
= 5;
sub
get_x {
my
$self
=
shift
;
isa_ok(
$self
,
"Foo"
,
"self is Foo in get_x"
);
return
$x
;
}
sub
set_x {
my
$self
=
shift
;
isa_ok(
$self
,
"Foo"
,
"self is Foo in set_x"
);
$x
=
shift
;
}
sub
get_y {
my
$self
=
shift
;
isa_ok(
$self
,
"Foo"
,
"self is Foo in get_y"
);
return
10;
}
my
$cx1
=
$rt1
->create_context();
$cx1
->bind_class(
name
=>
"Foo"
,
constructor
=> \
&Foo::new
,
ps
=> {
x
=> {
getter
=>
'get_x'
,
setter
=> \
&Foo::set_x
,
},
y
=> [
qw(get_y)
],
},
);
my
$r
=
$cx1
->
eval
(
"a = new Foo(); f = a.x;"
);
is(
$r
, 5);
$r
=
$cx1
->
eval
(
"a = new Foo(); f = a.x; f++; a.x = f; f = a.x; a.x;"
);
is(
$r
, 6);
}
{
my
$z
= 10;
sub
get_z {
my
$self
=
shift
;
is(
$self
,
"Foo"
,
"self is Foo in get_z"
);
return
$z
;
}
sub
set_z {
my
$self
=
shift
;
is(
$self
,
"Foo"
,
"self is Foo in set_z"
);
$z
=
shift
;
}
my
$cx1
=
$rt1
->create_context();
$cx1
->bind_class(
name
=>
"Foo"
,
constructor
=> \
&Foo::new
,
static_ps
=> {
z
=> [
qw(get_z set_z)
],
},
);
my
$r
=
$cx1
->
eval
(
"Foo.z;"
);
diag($@)
if
$@;
is(
$r
, 10,
"Foo.z is 10"
);
$cx1
->
eval
(
"Foo.z = 11;"
);
diag($@)
if
$@;
is(
$z
, 11,
"Foo.z is 11 after assignment"
);
}
{
my
$cx1
=
$rt1
->create_context();
$cx1
->bind_class(
name
=>
"Foo"
,
constructor
=>
"new"
,
ps
=> {
x
=> {
getter
=>
sub
{
return
"x"
; } } },
static_ps
=> {
y
=> {
getter
=>
sub
{
return
"y"
; } } }
);
is(
$cx1
->
eval
(
"(new Foo()).x"
),
"x"
,
"(new Foo()).x return x"
);
diag($@)
if
$@;
is(
$cx1
->
eval
(
"Foo.y"
),
"y"
,
"Foo.y returns y"
);
diag($@)
if
$@;
}
{
my
$cx1
=
$rt1
->create_context();
ok(JS_CLASS_NO_INSTANCE,
"Flag defined"
);
$cx1
->bind_class(
name
=>
"Baz"
,
package
=>
"Foo"
,
flags
=> JS_CLASS_NO_INSTANCE
);
throws_ok {
$cx1
->
eval
(
"new Baz()"
);
}
qr/can't be instantiated/
,
"Try to instantiate and got exception"
;
my
$foo
= Foo->new();
isa_ok(
$foo
,
"Foo"
,
"Perl can instantiate"
);
lives_ok {
$cx1
->bind_value(
"baz"
=>
$foo
) }
"Bind value works"
;
isa_ok(
$cx1
->
eval
(
"baz"
),
"Foo"
,
"Imported a Baz into JS"
);
is(
$cx1
->
eval
(
"baz + ''"
),
"[object Baz]"
,
"In JS isa Baz"
);
}