From: Lukas Mai Date: Thu, 1 Nov 2012 13:04:42 +0000 (+0100) Subject: import some (modified) tests from MSS X-Git-Tag: v1.00~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FFunction-Parameters.git;a=commitdiff_plain;h=d93106d762ee7326c1904c02e6f3202676dbce2d import some (modified) tests from MSS --- diff --git a/MANIFEST b/MANIFEST index ede94af..2fbfec2 100644 --- 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 index 0000000..bbca07f --- /dev/null +++ b/t/foreign/Method-Signatures-Simple/02-use.t @@ -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 index 0000000..580ccfb --- /dev/null +++ b/t/foreign/Method-Signatures-Simple/03-config.t @@ -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; +