Upgrade to Pro — share decks privately, control downloads, hide ads and more …

Perl5の静的解析入門 / The static analysis of Perl5

mackee
January 26, 2019

Perl5の静的解析入門 / The static analysis of Perl5

Perl5の静的解析入門
機械と人間双方の歩み寄りによる平和編

YAPC::Tokyo 2019 Room1 14:00 -

mackee

January 26, 2019
Tweet

More Decks by mackee

Other Decks in Programming

Transcript

  1. ΍Γํ 1 ਖ਼نදݱͰҾֻ͚ͬͨΓී௨ͷςΩετͱͯ͠ѻ͏ use Path::Tiny; my $target_package = "Example"; my

    $script = path("$target_package.pm")->slurp; my $is_valid_package = $script =~ /\Apackage $target_package;/; 13
  2. ࢖༻ྫ (1) use PPI; use PPI::Dumper; my $document = PPI::Document->new(\'my

    $v1 = $v2;'); PPI::Dumper->new($document)->print; 29
  3. ࢖༻ྫ (2) PPI::Document PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol

    '$v1' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$v2' PPI::Token::Structure ';' 30
  4. ࢖༻ྫ # my $hoge = "fuga"; ͷม਺໊ΛҾֻ͚ͬΔʹ͸ my $matcher =

    qr{ my (?&PerlOWS) ((?&PerlVariableScalar)) (?&PerlOWS) (?&PerlAssignmentOperator) (?&PerlOWS) (?&PerlString) (?&PerlOWS) ; $PPR::GRAMMAR }x 38
  5. ࢖༻ྫ my ($var) = grep { defined } $script =~

    $matcher; ͜ΕͰ $var ʹ "$hoge" ͕ೖΔ 39
  6. ฐࣾͩͱ͜͏͍͏όϦσʔγϣϯΛΑ͘΍͍ͬͯΔ͚ΕͲ sub do_something { my $self = shift; state $rule

    = Data::Validator->new( a1 => "Str", b1 => "UInt", ); my $args = $rule->validate(@_); my ($a1, $b1) = $args->{qw/a1 b1/}; # do something... } 46
  7. εΫϦϓτ͔Βؔ਺ఆٛΛൈ͖ग़͢ my $script = ...; my $sub_matcher = qr{ ((?&PerlSubroutineDeclaration))

    $PPR::GRAMMAR }x; my @decls = grep { defined } $script =~ m{$sub_matcher}gx; 48
  8. ؔ਺ఆ͔ٛΒؔ਺໊ͱϒϩοΫΛൈ͖ग़͢ my $subname_matcher = qr{ \Asub (?&PerlOWS) ((?&PerlQualifiedIdentifier)) (?&PerlOWS) ((?&PerlBlock))

    $PPR::GRAMMAR }x; for my $decl (@decls) { my ($subname, $block) = grep { defined } $decl =~ $subname_matcher; 49
  9. ؔ਺໊͕ΞϯμʔείΞ࢝·ΓͳΒεΩοϓ͢Δ for my $decl (@decls) { my ($subname, $block) =

    grep { defined } $decl =~ $subname_matcher; next if $subname =~ /\A_/; 50
  10. validatorͷఆٛ my $validator_matcher = qr{ ( (state) (?&PerlOWS) (?&PerlVariableScalar) (?&PerlOWS)

    (?&PerlAssignmentOperator) (?&PerlOWS) Data::Validator->new (?&PerlOWS) (?&PerlParenthesesList) (?&PerlOWS) ) $PPR::GRAMMAR }x; 51
  11. validatorͷఆ͕ٛ͋Δ͔Λௐ΂Δ for my $decl (@decls) { ... next if $subname

    =~ /\A_/; my ($validator) = grep { defined } $block =~ $validator_matcher; 52
  12. ͋ͱ͸ࣽΔͳΓম͘ͳΓ # warningΛग़͢ͳΓ if (!defined $validator) { warn "$subname Ͱ

    Data::Validator ͕࢖ΘΕͯͳ͍Αʂ"; } # ςετͰ͚ͤ͜͞ΔͳΓ use Test::More; fail "$subname Ͱ Data::Validator ͕࢖ΘΕͯͳ͍Αʂ"; 53
  13. Only perl can parse Perl (1) •Only perl can parse

    Perl ͳ෦෼ •PPIͷυΩϡϝϯτΑΓ @result = (dothis $foo, $bar); # Which of the following is it equivalent to? @result = (dothis($foo), $bar); @result = dothis($foo, $bar); 62
  14. Only perl can parse Perl (2) $ perl -MO=Deparse -e

    '@result = (dothis $foo, $bar);' @result = ($foo->dothis, $bar); -e syntax OK $ perl -MO=Deparse -e 'sub dothis {} @result = (dothis $foo, $bar);' sub dothis { } @result = dothis($foo, $bar); -e syntax OK 63
  15. Only perl can parse Perl (3) sub hoge { "hoge"

    } sub f { { hoge() => "fuga" } } # hashref or list ? my @result = f(); 65
  16. Only perl can parse Perl (4) use DDP; p @result;

    # [ # [0] "hoge", # [1] "fuga" # ] ϦετʹͳΔͷ͕ਖ਼ղ 66
  17. ͭ·ΓͪΌΜͱreturnॻ͚͹ղܾ͢Δ sub hoge { "hoge" } sub f { return

    { hoge() => "fuga" }; } # hashref desu!!! my @result = f(); 68
  18. greppability͕௿͍ίʔυ •ϝιου໊Λಈతʹ૊Έཱ͍ͯͯΔ my @params = qr/str vit dex int/; my

    $total = sum( map { my $method = $_ . "_factor"; $person->$method; } @params ); 74
  19. ͤΊͯจࣈྻ࿈݁Λ΍ΊΔ my @methods = qr/ str_factor vit_factor dex_factor int_factor /;

    my $total = sum(map { $person->$_ } @methods); •ϝιου໊͕ϢχʔΫͰ͋Ε͹grepʹҾͬ ͔͔ͬͯ͘Δ 76
  20. $PPR::GRAMMAR ΛݟͯΈΔ my $stmt_matcher = qr{ \G (?&PerlOWS) ((?&PerlStatement)) $PPR::GRAMMAR

    # <= ίϨ }x; my @stmts = grep { defined } $script =~ m{$stmt_matcher}gcx; 89
  21. 90

  22. ಡΈํ (3) ͱ͖Ͳ͖͜͏͍͏পʹग़͘Θ͚͢ΕͲ (?<PerlBuiltinFunction> # Optimized to match any Perl

    builtin name, without backtracking... (?=[^\W\d]) # Skip if possible (?> s(?>e(?>t(?>(?>(?>(?>hos|ne)t|gr)en|s(?>erven|ockop))t|p(?>r(?>iority|otoent)|went|grp)) | g(?>et(?>p(?>r(?>oto(?>byn(?>umber|ame)|ent)|iority)|w(?>ent|nam|uid)|eername|grp|pid)| | r(?>e(?>ad(?>lin[ek]|pipe|dir)?|(?>quir|vers|nam)e|winddir|turn|set|cv|do|f)|index|mdir | c(?>h(?>o(?>m?p|wn)|r(?>oot)?|dir|mod)|o(?>n(?>tinue|nect)|s)|lose(?>dir)?|aller|rypt) | e(?>nd(?>(?>hos|ne)t|p(?>roto|w)|serv|gr)ent|x(?>i(?>sts|t)|ec|p)|ach|val(?>bytes)?+|of | l(?>o(?>c(?>al(?>time)?|k)|g)|i(?>sten|nk)|(?>sta|as)t|c(?>first)?|ength) | u(?>n(?>(?>lin|pac)k|shift|def|tie)|c(?>first)?|mask|time) | p(?>r(?>ototype|intf?)|ack(?>age)?|o[ps]|ipe|ush) | d(?>bm(?>close|open)|e(?>fined|lete)|ump|ie|o) | f(?>or(?>m(?>line|at)|k)|ileno|cntl|c|lock) | t(?>i(?>mes?|ed?)|ell(?>dir)?|runcate) 95
  23. ͍͍ײ͡ͷՄࢹԽ (2) my $stmt_regexp = qr{ our (?&PerlOWS) \$GRAMMAR (?&PerlOWS)

    = (?&PerlOWS) ((?&PerlRegex)) $PPR::GRAMMAR }x; my ($regexp) = grep { defined } $ppr_script =~ /$stmt_regexp/gcx; # => "qr{ ... }" 100
  24. ͍͍ײ͡ͷՄࢹԽ (4) •͋ͱ͸࠶ؼͰτʔΫϯΛऩू͍ͯ͘͠ sub traverse { my ($tree, $bucket, $name)

    = @_; my $literal = ""; for my $child ($tree->children) { if (ref $child eq "PPIx::Regexp::Token::Literal") { $literal .= $child->content; } elsif (ref $child eq "PPIx::Regexp::Token::Whitespace") { # skip } else { if (length($literal) > 1 && $literal ne '\n') { $bucket->{$name}->{'"' . $literal . '"'} = 1; } $literal = ""; } 102
  25. ͍͍ײ͡ͷՄࢹԽ (5) if (ref $child eq "PPIx::Regexp::Token::Recursion") { next if

    $child->name eq "PerlOWS"; $bucket->{$name}->{$child->content} = 1; } if ($child->can("children")) { my $next_name = $name; if (ref $child eq "PPIx::Regexp::Structure::NamedCapture") { next if $child->name =~ /^PPR_/; $next_name = $name ? $name . " > (?&" . $child->name . ")" : "(?&" . $child->name . ")"; #PPIx::Regexp::Dumper->new($child)->print; } traverse($child, $bucket, $next_name); } } } 103
  26. ͍͍ײ͡ͷՄࢹԽ (6) (?&PerlPackageDeclaration) |-- "\}" |-- "package" |-- (?&PerlBlock) |--

    (?&PerlNWS) |-- (?&PerlQualifiedIdentifier) `-- (?&PerlVersionNumber) (?&PerlParenthesesList) |-- "\(" `-- (?&PerlExpression) (?&PerlPod) `-- "=cut" 104
  27. ܕ͸͢Ͱʹॻ͚Δ package Greeter { use Function::Parameters; use Function::Return; use Types::Standard

    qw/Str Int Bool/; method say_hello(Str :$name, Int :$times) :Return(Bool) { say $self . ": Hello " . $name for 1..$times; return 1; } } Greeter->say_hello(name => "shinpei0213", times => 10); 109
  28. ໰୊͸ keyword plugin method say_hello(Str :$name, Int :$times) :Return(Bool) {

    say $self . ": Hello " . $name for 1..$times; return 1; } keyword plugin ͸ perl 5.12.0 ͔Β࢖͑Δจ ๏֦ுػೳ 114
  29. Function::ParametersʹରԠ͢Δ (1) my $FP_GRAMMAR = qr{ (?(DEFINE) (?<PerlFunctionParametersMethod> method (?&PerlOWS)

    (?&PerlIdentifier) (?&PerlOWS) # => say_hello (?&kw_balanced_parens) (?&PerlOWS) # => (Str :$name, Int :$times) (?: (?&PerlAttributes) (?&PerlOWS) # => :Return(Bool) )?+ (?&PerlBlock) # => { ... } ) (?<PerlKeyword> (?&PerlFunctionParametersMethod) ) (?<kw_balanced_parens> \( (?: [^()]++ | (?&kw_balanced_parens) )*+ \) ) ) $PPR::GRAMMAR }x; 116
  30. Function::ParametersʹରԠ͢Δ (2) qr{ (?<PerlFunctionParametersMethod> method (?&PerlOWS) (?&PerlIdentifier) (?&PerlOWS) # =>

    say_hello (?&kw_balanced_parens) (?&PerlOWS) # => (Str :$name, Int :$times) (?: (?&PerlAttributes) (?&PerlOWS) # => :Return(Bool) )?+ (?&PerlBlock) # => { ... } ) } 117
  31. Function::ParametersʹରԠ͢Δ (4) my $doc_matcher = qr{ \A (?&PerlDocument) \Z $FP_GRAMMAR

    }x; say !!($script =~ $doc_matcher); # => 1 Perlίʔυͱͯ͠ೝࣝͯ͘͠Εͨʂ ͜ΕͰউ ͭΔʂ 119