Perl Advent Calender 2014 . 17th
use strict; | |
use warnings; | |
use utf8; | |
use feature qw/say/; | |
my $dog = bless {}, 'Dog'; | |
if (can $dog 'bow') { | |
say 'can bow'; | |
} | |
else { | |
say 'cannot bow'; | |
} # => cannot bow | |
=pod | |
use utf8; | |
use warnings; | |
use strict; | |
use feature 'say'; | |
my $dog = bless({}, 'Dog'); | |
if ($dog->can('bow')) { | |
say 'can bow'; | |
} | |
else { | |
say 'cannot bow'; | |
} |
use strict; | |
use warnings; | |
use utf8; | |
use feature qw/say/; | |
my $dog = bless {}, 'Dog'; | |
sub can { 1 } | |
if (can $dog 'bow') { # XXX => syntax error | |
say 'can bow'; | |
} | |
else { | |
say 'cannot bow'; | |
} | |
=pod | |
syntax error at can2.pl line 10, near "$dog 'bow'" | |
can2.pl had compilation errors. | |
use utf8; | |
use warnings; | |
use strict; | |
use feature 'say'; | |
my $dog = bless({}, 'Dog'); | |
sub can { | |
use warnings; | |
use strict; | |
use feature 'say'; | |
1; | |
} |
use strict; | |
use warnings; | |
use utf8; | |
package Dog; | |
sub new { bless {}, shift }; | |
package main; | |
use Test::More; | |
my $dog = Dog->new; | |
subtest 'isa' => sub { | |
isa_ok $dog, 'Dog'; | |
isa_ok $dog, 'UNIVERSAL'; | |
}; | |
subtest 'methods' => sub { | |
# http://perldoc.perl.org/UNIVERSAL.html | |
ok $dog->can('can'); | |
ok $dog->can('isa'); | |
ok $dog->can('VERSION'); | |
ok $dog->can('DOES'); | |
}; | |
subtest 'methods count' => sub { | |
require Class::Inspector; | |
is scalar @{Class::Inspector->methods('UNIVERSAL')}, 4; | |
is_deeply(Class::Inspector->methods('Dog'), [qw/new/]); | |
}; | |
done_testing; |
use strict; | |
use warnings; | |
use utf8; | |
package Dog; | |
sub new { bless {}, shift }; | |
package main; | |
use Test::More; | |
use Class::Inspector; | |
is_deeply Class::Inspector->methods('Dog'), [qw/new/]; | |
# XXX failed!! | |
# => Can't locate object method "is_deeply" via package "Class::Inspector" at can5.pl line 12 | |
=pod | |
use utf8; | |
package Dog; | |
sub new { | |
use warnings; | |
use strict; | |
bless {}, shift(); | |
} | |
package main; | |
sub BEGIN { | |
use warnings; | |
use strict; | |
require Test::More; | |
do { | |
'Test::More'->import | |
}; | |
} | |
use Class::Inspector; | |
use warnings; | |
use strict; | |
'Class::Inspector'->is_deeply->methods('Dog'), ['new']; | |
can5.pl syntax OK |
use strict; | |
use warnings; | |
use utf8; | |
use feature 'say'; | |
package A; | |
use constant FOO => 'foo'; | |
use constant BAR => 'bar'; | |
say FOO; # => foo | |
say BAR; # => bar | |
package B; | |
BEGIN { | |
require constant; | |
constant->import( FOO => 'foofoo' ); | |
constant->import( BAR => 'barbar' ); | |
} | |
say FOO; # => foofoo | |
say BAR; # => barbar | |
package C; | |
BEGIN { | |
require constant; | |
import constant FOO => 'foofoofoo'; | |
import constant BAR => 'barbarbar'; | |
} | |
say FOO; # => foofoofoo | |
say BAR; # => barbarbar | |
package D; | |
BEGIN { | |
require constant; | |
for my $key (qw/foo bar/) { | |
import constant uc $key => $key x 4; | |
} | |
} | |
say FOO; # => foofoofoofoo | |
say BAR; # => barbarbarbar | |
use strict; | |
use warnings; | |
use utf8; | |
use Test::More; | |
use Test::Exception; | |
use Test::Perl::Critic; | |
use List::Util qw/sum/; | |
sub sum_map { | |
my $cb = shift; | |
sum map { $cb->($_); } @_; | |
} | |
subtest 'basic' => sub { | |
is sum_map(sub { $_[0] * 10 }, 1..10), 550; | |
}; | |
subtest 'dies' => sub { | |
dies_ok { sum_map { $_ * 10 }, 1..10; } | |
# => | |
# Use of uninitialized value $_ in multiplication (*) at proto.pl line 23. | |
# Odd number of elements in anonymous hash at proto.pl line 23. | |
# Not a CODE reference at proto.pl line 10. | |
}; | |
subtest 'critic' => sub { | |
critic_ok($0); | |
}; | |
done_testing; |
use strict; | |
use warnings; | |
use utf8; | |
use Test::More; | |
use Test::Exception; | |
use Test::Perl::Critic; | |
use List::Util qw/sum/; | |
sub sum_map (&@) { | |
my $cb = shift; | |
sum map { $cb->($_) } @_; | |
} | |
subtest 'basic' => sub { | |
my $ret = sum_map { $_ * 10 } 1..10; | |
is $ret, 550; | |
}; | |
subtest 'other use case' => sub { | |
my $ret = sum_map(sub { $_[0] * 10 }, 1..10); | |
is $ret, 550; | |
}; | |
subtest 'critic' => sub { | |
critic_ok($0); ## failed!! | |
# not ok 1 - Test::Perl::Critic for "proto2.pl" | |
# Failed test 'Test::Perl::Critic for "proto2.pl"' | |
# at proto2.pl line 27. | |
# | |
# Perl::Critic found these violations in "proto2.pl": | |
# Subroutine prototypes used at line 9, column 1. See page 194 of PBP. (Severity: 5) | |
}; | |
done_testing; |
use strict; | |
use warnings; | |
use utf8; | |
use Test::More; | |
use Test::Exception; | |
use Test::Perl::Critic; | |
use List::Util qw/sum/; | |
sub sum_map (&@) { ## no critic | |
my $cb = shift; | |
sum map { $cb->($_) } @_; | |
} | |
subtest 'critic' => sub { | |
critic_ok($0), '注釈をつけることで回避'; | |
# ref http://search.cpan.org/~thaljef/Perl-Critic-1.123/lib/Perl/Critic.pm#BENDING_THE_RULES | |
}; | |
done_testing; |
use strict; | |
use warnings; | |
use utf8; | |
use feature 'say'; | |
#use Try::Tiny; | |
try { | |
say 'foo'; | |
say 'bar'; | |
} | |
# => | |
# foo | |
# bar | |
# Can't locate object method "try" via package "1" (perhaps you forgot to load "1"?) at try2.pl line 6. | |
=pod | |
# perl -MO=Deparse % | |
use utf8; | |
use warnings; | |
use strict; | |
use feature 'say'; | |
do { | |
say 'foo'; | |
say 'bar' | |
}->try; | |
try2.pl syntax OK | |
=cut |
use strict; | |
use warnings; | |
use utf8; | |
use feature 'say'; | |
#use Try::Tiny; | |
try { | |
say 'foo'; | |
bless {}, 'foo'; | |
} | |
# => | |
# foo | |
# Can't locate object method "try" via package "foo" at try2.pl line 6. | |
=pod | |
# perl -MO=Deparse % | |
use utf8; | |
use warnings; | |
use strict; | |
use feature 'say'; | |
do { | |
say 'foo'; | |
bless {}, 'foo' | |
}->try; | |
try2.pl syntax OK | |
=cut |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment