#!/usr/bin/perl -w
no
warnings
qw( uninitialized )
;
BEGIN
{
plan
tests
=> 21;
unless
(
grep
/blib/,
@INC
)
{
chdir
't'
if
-d
't'
;
unshift
@INC
,
'../lib'
if
-d
'../lib'
;
unshift
@INC
,
'./lib'
if
-d
'./lib'
;
}
}
use
Carp
qw( croak cluck )
;
my
(
$obj
);
ok
$obj
= new Trinket::Object();
ok
$obj
= new Trinket::Object
({
id
=>
'1'
,
});
eval
' $obj->set_foo("test"); '
;
ok $@ =~ /No such property
'foo'
to set/;
eval
' $obj->get_foo("test"); '
;
ok $@ =~ /No such property
'foo'
to get/;
ok
$obj
->add_property
(
foo
=>
'char'
, 0,
'The foo property'
);
ok
$obj
->set_foo(
"test"
);
ok
$obj
->get_foo() eq
'test'
;
ok
$obj
= new TestObject();
ok
defined
$TestObject::PROPERTIES
{id};
ok
$obj
->get_baz() eq META_PROP_INDEXED;
$obj
= new TestObject();
my
(
$dirty
,
$wrong
,
$name
,
$vals
);
$dirty
=
$obj
->_find_dirty();
$wrong
= 0;
while
((
$name
,
$vals
) =
each
%{
$dirty
})
{
$wrong
++
if
(
$name
ne
'class'
); }
ok
$wrong
== 0;
ok (
$dirty
->{class}->[0] eq
''
) &&
(
$dirty
->{class}->[1] eq
'TestObject'
);
$obj
->_clean_all();
$dirty
=
$obj
->_find_dirty();
$wrong
= 0;
while
((
$name
,
$vals
) =
each
%{
$dirty
})
{
$wrong
++; }
ok
$wrong
== 0;
$obj
->add_property(
foo
=>
'char'
, 1,
'The foo property'
);
$obj
->add_property(
xzzxy
=>
'char'
, 0,
'The xzzxy property'
);
$dirty
=
$obj
->_find_dirty();
ok (!
defined
$dirty
->{foo}) && (!
defined
$dirty
->{xzzxy});
$obj
->set_xzzxy(
"Nothing happens."
);
$dirty
=
$obj
->_find_dirty_indices();
ok !
defined
$dirty
->{xzzxy};
$dirty
=
$obj
->_find_dirty();
ok
defined
$dirty
->{xzzxy};
$obj
->set_foo(
"borkborkbork"
);
$dirty
=
$obj
->_find_dirty_indices();
ok
defined
$dirty
->{foo};
$dirty
=
$obj
->_find_dirty();
ok
defined
$dirty
->{foo};
$obj
->_clean_all();
$obj
->set_foo(
"A m00se once bit my sister."
);
$dirty
=
$obj
->_find_dirty();
ok (
$dirty
->{foo}->[DIRTY_OLD_VALUE] eq
'borkborkbork'
) &&
(
$dirty
->{foo}->[DIRTY_NEW_VALUE] eq
'A m00se once bit my sister.'
);
$obj
->remove_property(
'foo'
);
$obj
->remove_property(
'xzzxy'
);
eval
' $obj->set_foo("test"); '
;
ok $@ =~ /No such property
'foo'
to set/;
eval
' $obj->set_xzzxy("test"); '
;
ok $@ =~ /No such property
'xzzxy'
to set/;
exit
(0);
{
BEGIN
{
our
$VERSION
=
"0.0"
;
our
@ISA
=
qw( Trinket::Object )
;
our
$DESCRIPTION
=
'Test object class'
;
our
%PROPERTIES
=
(
mung
=> [
'char'
, 1,
'Mung'
],
bar
=> [
'char'
, 1,
'Bar'
],
baz
=> [
'char'
, 1,
'Baz'
],
);
Trinket::Object::
import
();
}
sub
get_baz
{
my
$self
=
shift
;
return
META_PROP_INDEXED;
}
}