import some (modified) tests from MSS
Lukas Mai [Thu, 1 Nov 2012 13:04:42 +0000 (14:04 +0100)]
MANIFEST
t/foreign/Method-Signatures-Simple/02-use.t [new file with mode: 0644]
t/foreign/Method-Signatures-Simple/03-config.t [new file with mode: 0644]

index ede94af..2fbfec2 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -21,6 +21,8 @@ t/eating_strict_error.fail
 t/eating_strict_error.t
 t/eating_strict_error_2.fail
 t/elsewhere.t
+t/foreign/Method-Signatures-Simple/02-use.t
+t/foreign/Method-Signatures-Simple/03-config.t
 t/foreign/Method-Signatures/anon.t
 t/foreign/Method-Signatures/array_param.t
 t/foreign/Method-Signatures/at_underscore.t
diff --git a/t/foreign/Method-Signatures-Simple/02-use.t b/t/foreign/Method-Signatures-Simple/02-use.t
new file mode 100644 (file)
index 0000000..bbca07f
--- /dev/null
@@ -0,0 +1,36 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More tests => 7;
+BEGIN { use_ok 'Function::Parameters' }
+
+{
+    package My::Obj;
+    use Function::Parameters qw(:strict);
+
+    method make($class: %opts) {
+        bless {%opts}, $class;
+    }
+    method first : lvalue {
+        $self->{first};
+    }
+    method second {
+        $self->first + 1;
+    }
+    method nth($inc) {
+        $self->first + $inc;
+    }
+}
+
+my $o = My::Obj->make(first => 1);
+is $o->first, 1;
+is $o->second, 2;
+is $o->nth(10), 11;
+
+$o->first = 10;
+
+is $o->first, 10;
+is $o->second, 11;
+is $o->nth(10), 20;
+
diff --git a/t/foreign/Method-Signatures-Simple/03-config.t b/t/foreign/Method-Signatures-Simple/03-config.t
new file mode 100644 (file)
index 0000000..580ccfb
--- /dev/null
@@ -0,0 +1,50 @@
+#!perl
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More tests => 3;
+
+# testing that we can install several different keywords into the same scope
+{
+    package Monster;
+
+    use Function::Parameters;
+    use Function::Parameters {
+       action => { shift => '$monster', invocant => 1 },
+       constructor => { shift => '$species', invocant => 1 },
+       function => 'function',
+    };
+
+    constructor spawn {
+        bless {@_}, $species;
+    }
+
+    action speak (@words) {
+        return join ' ', $monster->{name}, $monster->{voices}, @words;
+    }
+
+    action attack ($me: $you) {
+        $you->take_damage($me->{strength});
+    }
+
+    method take_damage ($hits) {
+        $self->{hitpoints} = calculate_damage($self->{hitpoints}, $hits);
+        if($self->{hitpoints} <= 0) {
+            $self->{is_dead} = 1;
+        }
+    }
+
+    function calculate_damage ($hitpoints, $damage) {
+        return $hitpoints - $damage;
+    }
+}
+
+package main;
+my $hellhound = Monster->spawn( name => "Hellhound", voices => "barks", strength => 22, hitpoints => 100 );
+is $hellhound->speak(qw(arf arf)), 'Hellhound barks arf arf';
+
+my $human = Monster->spawn( name => 'human', voices => 'whispers', strength => 4, hitpoints => 16 );
+$hellhound->attack($human);
+is $human->{is_dead}, 1;
+is $human->{hitpoints}, -6;
+