Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[t/spec]

 * some more OO tests as requested by jonathon++
 * moved delegation tests to t/spec/
 * some POD fixes


git-svn-id: http://svn.pugscode.org/pugs@20403 c213334d-75ef-0310-aa23-eaa082d1ae64
  • Loading branch information...
commit ebc0a2c09540946ad210a9ce99b38713fde99411 1 parent 5dd160c
moritz authored
View
102 S12-attributes/delegation.t
@@ -0,0 +1,102 @@
+use v6-alpha;
+
+use Test;
+
+plan 41;
+
+=begin desc
+
+Delegation tests from L<S12/Delegation>
+
+=end desc
+
+# L<S12/Delegation>
+
+class Backend1 { method hi() { 42 }; method cool() { 1337 } }
+class Backend2 { method hi() { 23 }; method cool() { 539 } }
+class Frontend { has $.backend is rw handles "hi" }
+ok Backend1.new, "class definition worked";
+
+is Backend1.new.hi, 42, "basic sanity (1)";
+is Backend2.new.hi, 23, "basic sanity (2)";
+
+{
+ my $a;
+ ok ($a = Frontend.new), "basic instantiation worked (1)";
+ ok (!try { $a.hi }), "calling a method on no object didn't succeed (1)";
+ ok ($a.backend = Backend1.new()), "setting a handler object (1)";
+ ok (!($a ~~ Backend1)), "object wasn't isa()ed (1)";
+ is try{ $a.hi }, 42, "method was successfully handled by backend object (1)";
+}
+
+{
+ my $a;
+ ok ($a = Frontend.new), "basic instantiation worked (2)";
+ ok (!try { $a.hi }), "calling a method on no object didn't succeed (2)";
+ ok ($a.backend = Backend2.new()), "setting a handler object (2)";
+ ok (!($a ~~ Backend2)), "object wasn't isa()ed (2)";
+ is try{ $a.hi }, 23, "method was successfully handled by backend object (2)";
+}
+
+
+# L<S12/Delegation/"Any other kind of argument" "smartmatch selector for method">
+class ReFrontend { has $.backend is rw handles /^hi/ };
+ok ReFrontend.new, "class definition using a smartmatch handle worked";
+
+{
+ my $a;
+ ok ($a = ReFrontend.new), "basic instantiation worked (3)";
+ ok (!try { $a.hi }), "calling a method on no object didn't succeed (3)";
+ ok ($a.backend = Backend1.new()), "setting a handler object (3)";
+ ok (!($a ~~ Backend1)), "object wasn't isa()ed (3)";
+ is try{ $a.hi }, 42, "method was successfully handled by backend object (3)", :todo<feature>;
+}
+
+
+# L<S12/Delegation/If you say>
+class ClassFrontend { has $.backend is rw handles Backend2 };
+ok ClassFrontend.new, "class definition using a Class handle worked";
+{
+ my $a;
+ ok ($a = ClassFrontend.new), "basic instantiation worked (4)";
+ ok (!try { $a.hi }), "calling a method on no object didn't succeed (4)";
+ ok ($a.backend = Backend1.new()), "setting a handler object (4)";
+ ok (!($a ~~ Backend1)), "object wasn't isa()ed (4-1)";
+ ok (!($a ~~ Backend2)), "object wasn't isa()ed (4-2)";
+ is (try{ $a.hi }), 42, "method was successfully handled by backend object (4)", :todo<feature>;
+}
+
+
+# L<S12/Delegation/You can specify multiple method names:>
+class MultiFrontend { has $.backend is rw handles <hi cool> }
+ok MultiFrontend.new, "class definition using multiple method names worked";
+{
+ my $a;
+ ok ($a = MultiFrontend.new), "basic instantiation worked (5)";
+ ok (!try { $a.hi }), "calling a method on no object didn't succeed (5-1)";
+ ok (!try { $a.cool }), "calling a method on no object didn't succeed (5-2)";
+ ok ($a.backend = Backend1.new()), "setting a handler object (5)";
+ ok (!($a ~~ Backend1)), "object wasn't isa()ed (5)";
+ is (try { $a.hi }), 42, "method was successfully handled by backend object (5-1)", :todo<feature>;
+ is (try { $a.cool }), 1337, "method was successfully handled by backend object (5-2)", :todo<feature>;
+}
+
+#
+
+class MyArray {
+ has @.elems handles "join";
+ method concat handles <chars bytes graphs codes> { .join("") }
+}
+
+ok MyArray.new, "class with attribute and return value delegation";
+{
+ my $a;
+ ok ($a = MyArray.new(elems => [1..5])), "basic instantiation worked";
+ is try{ $a.concat }, "12345", "attribute delegation worked", :todo<feature>;
+ is try{ $a.bytes }, 5, "return delegation worked", :todo<feature>;
+ is try{ $a.chars }, 5, "return delegation worked", :todo<feature>;
+ is try{ $a.codes }, 5, "return delegation worked", :todo<feature>;
+ is try{ $a.graphs }, 5, "return delegation worked", :todo<feature>;
+}
+
+# vim: syn=perl6
View
12 S12-class/inheritance.t
@@ -0,0 +1,12 @@
+use v6;
+
+use Test;
+plan 1;
+
+# L<S12/Class methods/>
+
+class A is B { method f {1; } };
+class B { method g { self.f } };
+
+is(A.g(), 1, 'inheritance works on class methods');
+
View
58 S12-class/methods.t → S12-methods/calling_syntax.t
@@ -1,24 +1,34 @@
-use v6;
-
-use Test;
-
-plan 5;
-
-class Foo {
- method foo {
- 42
- }
- method bar() {
- 101
- }
- method identity($x) {
- $x
- }
-}
-
-my $x = Foo.new();
-is($x.foo, 42, 'called a method without parens');
-is($x.foo(), 42, 'called a method without parens');
-is($x.bar, 101, 'called a method with parens');
-is($x.bar(), 101, 'called a method with parens');
-is($x.identity("w00t"), "w00t", 'called a method with a parameter');
+use v6;
+
+use Test;
+
+plan 5;
+
+=begin description
+
+Test for
+
+=end description
+
+# L<S02/Literals/"$x.foo;">
+
+class Foo {
+ method foo {
+ 42
+ }
+ method bar() {
+ 101
+ }
+ method identity($x) {
+ $x
+ }
+}
+
+my $x = Foo.new();
+is($x.foo, 42, 'called a method without parens');
+is($x.foo(), 42, 'called a method without parens');
+is($x.bar, 101, 'called a method with parens');
+is($x.bar(), 101, 'called a method with parens');
+is($x.identity("w00t"), "w00t", 'called a method with a parameter');
+
+# vim: syn=perl6
View
43 S12-methods/private_methods.t
@@ -0,0 +1,43 @@
+use v6;
+use Test;
+
+plan 3;
+
+# L<S12/Methods/"Private methods are declared using my">
+
+class A {
+ my method !private {
+ 12;
+ }
+ method public {
+ self!private
+ }
+}
+
+is A.new().public, 12, 'Can call private method from within the class';
+
+# L<S12/Roles/"same, but &foo is aliased to &!foo">
+
+# S12 says that 'my method foo' is the same as 'my method !foo', but
+# also installs the &foo alias for &!foo
+# but it's only stated for roles. Is that true for classes as well?
+
+
+class B {
+ my method private {
+ 24;
+ }
+ method public1 {
+ self!private();
+ }
+ method public2 {
+ self.private();
+ }
+}
+
+my $b = B.new();
+
+is $b.public1, 24, '"my method private" can be called as self!private';
+is $b.public2, 24, '"my method private" can be called as self.private';
+
+# vim: syn=perl6
View
49 S12-role/composition.t
@@ -0,0 +1,49 @@
+use v6;
+use Test;
+plan 8;
+
+role rA {
+ method mA1 {
+ 'mA1';
+ }
+ method mA2 {
+ 'mA2';
+ }
+};
+
+role rB {
+ method mB1 {
+ 'mB1';
+ }
+ method mB2 {
+ 'mB2';
+ }
+};
+
+class C1 does rA {
+ method mC1 {
+ 'mC1';
+ }
+};
+
+my $x = C1.new();
+
+is $x.mC1, 'mC1', 'Can call method of class with mixed in role';
+is $x.mA1, 'mA1', 'Call first method from role';
+is $x.mA2, 'mA2', 'Call second method from role';
+
+class C2 does rA does rB {
+ method mC2 {
+ 'mC2';
+ }
+}
+
+my $y = C2.new();
+
+is $y.mC2, 'mC2', 'Can call method of class with two roles mixed in';
+is $y.mA1, 'mA1', 'Can call mixed in method (two roles) 1';
+is $y.mA2, 'mA2', 'Can call mixed in method (two roles) 2';
+is $y.mB1, 'mB1', 'Can call mixed in method (two roles) 3';
+is $y.mB2, 'mB2', 'Can call mixed in method (two roles) 4';
+
+# vim: syn=perl6
Please sign in to comment.
Something went wrong with that request. Please try again.