Changeset 3373 for ext/Perl-MetaModel/t/12_Perl_Meta_MetaClass_methods.t

Timestamp:

05/18/05 03:51:03 (4 years ago)

Author:

Stevan

svk:copy_cache_prev:

4945

Message:

Perl::MetaModel? - findMethod and invokeMethod methods coded and tested (and an isMethodSupported too); Smalltalk Meta-Model++

Files:

• ext/Perl-MetaModel/t/12_Perl_Meta_MetaClass_methods.t (modified) (3 diffs)

ext/Perl-MetaModel/t/12_Perl_Meta_MetaClass_methods.t

@@ -4 +4 @@
 use Test;
 
-plan 10;
+plan 25;
 
 use Perl::Meta::Class;
@@ -23 +23 @@
 
 my $method1 = Perl::Meta::Method.new();
-my $method2 = Perl::Meta::Method.new();
+my $method2 = Perl::Meta::Method.new(code => sub { 'Hello World' });
 
 $mmc.addMethod('method1', $method1);
 $mmc.addMethod('method2', $method2);
+
+ok($mmc.findMethod('method1') =:= $method1, '... found the right method');
+ok($mmc.findMethod('method2') =:= $method2, '... found the right method');
+
+ok(!$mmc.isMethodSupported('method3'), '... did not find the method (as expected)');
 
 {
@@ -50 +55 @@
     ok(%methods{'method1'} =:= $method1, '... the first is $method1');     
 }
+
+my $sub_mmc = Perl::Meta::Class::new('SubClass');
+$sub_mmc.superclass($mmc);
+
+$sub_mmc.addMethod('method2', $method2);
+
+ok($sub_mmc.isMethodSupported('method1'), '... did find the method in parent class');
+ok($sub_mmc.findMethod('method1') =:= $method1, '... found the right method (in parent class)');
+
+ok(!$mmc.isMethodSupported('method2'), '... did not find the method (as expected) in parent class');
+ok($sub_mmc.isMethodSupported('method2'), '... did find the method (as expected) in class');
+
+my $sub_sub_mmc = Perl::Meta::Class::new('SubSubClass');
+$sub_sub_mmc.superclass($sub_mmc);
+
+ok($sub_sub_mmc.isMethodSupported('method1'), '... did find the method in parents parent class');
+ok($sub_sub_mmc.findMethod('method1') =:= $method1, '... found the right method (in parents parent class)');
+ok($sub_sub_mmc.findMethod('method2'), '... did find the method (as expected) in parents class');
+
+# check some errors
+
+$!= undef; 
+dies_ok {
+    $mmc.invokeMethod('method2');
+}, '... this dies as expected';
+like($!, rx:perl5/^Method not found/, '... got the right error');
+
+$!= undef; 
+dies_ok {
+    $sub_sub_mmc.invokeMethod('method1');
+}, '... this dies as expected';
+like($!, rx:perl5/^Method has no code/, '... got the right error');
+
+is($sub_mmc.invokeMethod('method2'), 'Hello World', '... the method returned what we expected');