Create a gist now

Instantly share code, notes, and snippets.

@kfly8 /can.pl
Last active Aug 29, 2015

What would you like to do?
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;
use feature qw/say/;
my $dog = bless {}, 'Dog';
sub can { 1 }
if (can $dog, 'bow') { # リストにするため、カンマを入れた
say 'can bow';
}
else {
say 'cannot bow';
} # => can bow
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
use strict;
use warnings;
use utf8;
use feature 'say';
use Try::Tiny;
try {
say 'foo';
bless {}, 'foo';
}
# => foo
=pod
# perl -MO=Deparse %
use utf8;
use Try::Tiny;
use warnings;
use strict;
use feature 'say';
try sub {
say 'foo';
bless {}, 'foo';
}
;
try3.pl syntax OK
=cut
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment