PPI-1.278/0000775000175000017500000000000014573465137010630 5ustar olafolafPPI-1.278/t/0000775000175000017500000000000014573465137011073 5ustar olafolafPPI-1.278/t/14_charsets.t0000644000175000017500000000504214573465137013377 0ustar olafolaf#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use Test::More; BEGIN { if ($] < 5.008007) { Test::More->import( skip_all => "Unicode support requires perl 5.8.7" ); exit(0); } plan( tests => 44 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); } use utf8; # perl version check above says this is okay use Params::Util qw( _INSTANCE ); use PPI (); use Helper 'safe_new'; sub good_ok { my $source = shift; my $message = shift; my $doc = safe_new \$source; ok( _INSTANCE($doc, 'PPI::Document'), $message ); if ( ! _INSTANCE($doc, 'PPI::Document') ) { diag($PPI::Document::errstr); } } ##################################################################### # Begin Tests # We cannot reliably support Unicode on anything less than 5.8.5 SKIP: { # In some (weird) cases with custom locales, things aren't words # that should be unless ( "ä" =~ /\w/ ) { skip( "Unicode-incompatible locale in use (apparently)", 11 ); } # Notorious test case. # In 1.203 this test case causes a memory leaking infinite loop # that consumes all available memory and then crashes the process. good_ok( '一();', "Function with Chinese characters" ); # Byte order mark with no unicode content good_ok( "\xef\xbb\xbf1;\n", "BOM without actual unicode content" ); # Testing accented characters in UTF-8 good_ok( 'sub func { }', "Parsed code without accented chars" ); good_ok( 'rätselhaft();', "Function with umlaut" ); good_ok( 'ätselhaft()', "Starting with umlaut" ); good_ok( '"rätselhaft"', "In double quotes" ); good_ok( "'rätselhaft'", "In single quotes" ); good_ok( 'sub func { s/a/ä/g; }', "Regex with umlaut" ); good_ok( 'sub func { $ä=1; }', "Variable with umlaut" ); good_ok( '$一 = "壹";', "Variables with Chinese characters" ); good_ok( '$a=1; # ä is an umlaut', "Comment with umlaut" ); good_ok( <<'END_CODE', "POD with umlaut" ); sub func { } =pod =head1 Umlauts like ä } END_CODE ok(utf8::is_utf8('κλειδί'), "utf8 flag set on source string"); good_ok( 'my %h = ( κλειδί => "Clé" );', "Hash with greek key in character string" ); use Encode (); my $bytes = Encode::encode('utf8', 'use utf8; my %h = ( κλειδί => "Clé" );'); ok(!utf8::is_utf8($bytes), "utf8 flag not set on byte string"); { local $TODO = "Fix CRASH"; good_ok( $bytes, "Hash with greek key in bytes string" ); } } PPI-1.278/t/09_normal.t0000644000175000017500000000361114573465137013057 0ustar olafolaf#!/usr/bin/perl # Testing of the normalization functions. # (only very basic at this point) use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 21 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Singletons qw( %LAYER ); use Helper 'safe_new'; ##################################################################### # Creation and Manipulation SCOPE: { my $Document = safe_new \'my $foo = bar();'; my $Normal = $Document->normalized; isa_ok( $Normal, 'PPI::Document::Normalized' ); is( $Normal->version, $PPI::Normal::VERSION, '->version matches $VERSION' ); my $functions = $Normal->functions; is( ref $functions, 'ARRAY', '->functions returns an array ref' ); ok( scalar(@$functions), '->functions returns at least 1 function' ); } ##################################################################### # Basic Empiric Tests # Basic empiric testing SCOPE: { # The following should be equivalent my $Document1 = safe_new \'my $foo = 1; # comment'; my $Document2 = safe_new \'my $foo=1 ;# different comment'; my $Document3 = safe_new \'sub foo { print "Hello World!\n"; }'; my $Normal1 = $Document1->normalized; my $Normal2 = $Document2->normalized; my $Normal3 = $Document3->normalized; isa_ok( $Normal1, 'PPI::Document::Normalized' ); isa_ok( $Normal2, 'PPI::Document::Normalized' ); isa_ok( $Normal3, 'PPI::Document::Normalized' ); is( $Normal1->equal( $Normal2 ), 1, '->equal returns true for equivalent code' ); is( $Normal1->equal( $Normal3 ), '', '->equal returns false for different code' ); } NO_DOUBLE_REG: { sub just_a_test_sub { "meep" } ok( PPI::Normal->register( "main::just_a_test_sub", 2 ), "can add subs" ); is $LAYER{2}[-1], "main::just_a_test_sub", "and find subs at right layer"; my $size = @{ $LAYER{2} }; ok( PPI::Normal->register( "main::just_a_test_sub", 2 ), "can add subs again" ); is scalar @{ $LAYER{2} }, $size, "but sub isn't added twice"; } PPI-1.278/t/ppi_token_operator.t0000644000175000017500000004632714573465137015175 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Operator use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 3009 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Singletons qw( %KEYWORDS %OPERATOR ); use Helper 'safe_new'; FIND_ONE_OP: { my $source = '$a = .987;'; my $doc = safe_new \$source; my $ops = $doc->find( 'Token::Number::Float' ); is( ref $ops, 'ARRAY', "found number" ); is( @$ops, 1, "number found exactly once" ); is( $ops->[0]->content(), '.987', "text matches" ); $ops = $doc->find( 'Token::Operator' ); is( ref $ops, 'ARRAY', "operator = found operators in number test" ); is( @$ops, 1, "operator = found exactly once in number test" ); } PARSE_ALL_OPERATORS: { foreach my $op ( sort keys %OPERATOR ) { my $source = $op eq '<>' || $op eq '<<>>' ? $op . ';' : "\$foo $op 2;"; my $doc = safe_new \$source; my $ops = $doc->find( $op eq '<<>>' || $op eq '<>' ? 'Token::QuoteLike::Readline' : 'Token::Operator' ); is( ref $ops, 'ARRAY', "operator $op found operators" ); is( @$ops, 1, "operator $op found exactly once" ); is( $ops->[0]->content(), $op, "operator $op operator text matches" ); } } OPERATOR_X: { my @tests = ( { desc => 'generic bareword with integer', # github #133 code => 'bareword x 3', expected => [ 'PPI::Token::Word' => 'bareword', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'generic bareword with integer run together', # github #133 code => 'bareword x3', expected => [ 'PPI::Token::Word' => 'bareword', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '3', ], }, { desc => 'preceding word looks like a force but is not', # github #133 code => '$a->package x3', expected => [ 'PPI::Token::Symbol' => '$a', 'PPI::Token::Operator' => '->', 'PPI::Token::Word' => 'package', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '3', ], }, { desc => 'method with method', code => 'sort { $a->package cmp $b->package } ();', expected => [ 'PPI::Token::Word' => 'sort', 'PPI::Token::Whitespace' => ' ', 'PPI::Structure::Block'=> '{ $a->package cmp $b->package }', 'PPI::Token::Structure'=> '{', 'PPI::Token::Whitespace'=> ' ', 'PPI::Statement'=> '$a->package cmp $b->package', 'PPI::Token::Symbol'=> '$a', 'PPI::Token::Operator'=> '->', 'PPI::Token::Word'=> 'package', 'PPI::Token::Whitespace'=> ' ', 'PPI::Token::Operator'=> 'cmp', 'PPI::Token::Whitespace'=> ' ', 'PPI::Token::Symbol'=> '$b', 'PPI::Token::Operator'=> '->', 'PPI::Token::Word'=> 'package', 'PPI::Token::Whitespace'=> ' ', 'PPI::Token::Structure'=> '}', 'PPI::Token::Whitespace'=> ' ', 'PPI::Structure::List'=> '()', 'PPI::Token::Structure'=> '(', 'PPI::Token::Structure'=> ')', 'PPI::Token::Structure'=> ';' ], }, { desc => 'method with integer', code => 'c->d x 3', expected => [ 'PPI::Token::Word' => 'c', 'PPI::Token::Operator' => '->', 'PPI::Token::Word' => 'd', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'integer with integer', code => '1 x 3', expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'string with integer', code => '"y" x 3', expected => [ 'PPI::Token::Quote::Double' => '"y"', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'string with integer', code => 'qq{y} x 3', expected => [ 'PPI::Token::Quote::Interpolate' => 'qq{y}', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'string no whitespace with integer', code => '"y"x 3', expected => [ 'PPI::Token::Quote::Double' => '"y"', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'variable with integer', code => '$a x 3', expected => [ 'PPI::Token::Symbol' => '$a', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'variable with no whitespace integer', code => '$a x3', expected => [ 'PPI::Token::Symbol' => '$a', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '3', ], }, { desc => 'variable, post ++, x, no whitespace anywhere', code => '$a++x3', expected => [ 'PPI::Token::Symbol' => '$a', 'PPI::Token::Operator' => '++', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '3', ], }, { desc => 'double quote, no whitespace', code => '"y"x 3', expected => [ 'PPI::Token::Quote::Double' => '"y"', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'single quote, no whitespace', code => "'y'x 3", expected => [ 'PPI::Token::Quote::Single' => "'y'", 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'parens, no whitespace, number', code => "(5)x 3", expected => [ 'PPI::Structure::List' => '(5)', 'PPI::Token::Structure' => '(', 'PPI::Statement::Expression' => '5', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ')', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '3', ], }, { desc => 'number following x is hex', code => "1x0x1", expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number::Hex' => '0x1', ], }, { desc => 'x followed by symbol', code => '1 x$y', expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Symbol' => '$y', ], }, { desc => 'x= with no trailing whitespace, symbol', code => '$z x=3', expected => [ 'PPI::Token::Symbol' => '$z', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x=', 'PPI::Token::Number' => '3', ], }, { desc => 'x= with no trailing whitespace, symbol', code => '$z x=$y', expected => [ 'PPI::Token::Symbol' => '$z', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x=', 'PPI::Token::Symbol' => '$y', ], }, { desc => 'x plus whitespace on the left of => that is not the first token in the doc', code => '1;x =>1;', expected => [ 'PPI::Statement' => '1;', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ';', 'PPI::Statement' => 'x =>1;', 'PPI::Token::Word' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ';', ], }, { desc => 'x on the left of => that is not the first token in the doc', code => '1;x=>1;', expected => [ 'PPI::Statement' => '1;', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ';', 'PPI::Statement' => 'x=>1;', 'PPI::Token::Word' => 'x', 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ';', ], }, { desc => 'x on the left of => that is not the first token in the doc', code => '$hash{x}=1;', expected => [ 'PPI::Token::Symbol' => '$hash', 'PPI::Structure::Subscript' => '{x}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => 'x', 'PPI::Token::Word' => 'x', 'PPI::Token::Structure' => '}', 'PPI::Token::Operator' => '=', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ';', ], }, { desc => 'x plus whitespace on the left of => is not an operator', code => 'x =>1', expected => [ 'PPI::Token::Word' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '1', ], }, { desc => 'x immediately followed by => should not be mistaken for x=', code => 'x=>1', expected => [ 'PPI::Token::Word' => 'x', 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '1', ], }, { desc => 'xx on left of => not mistaken for an x operator', code => 'xx=>1', expected => [ 'PPI::Token::Word' => 'xx', 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '1', ], }, { desc => 'x right of => is not an operator', code => '1=>x', expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Operator' => '=>', 'PPI::Token::Word' => 'x', ], }, { desc => 'xor right of => is an operator', code => '1=>xor', expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Operator' => '=>', 'PPI::Token::Operator' => 'xor', ], }, { desc => 'RT 37892: list as arg to x operator 1', code => '(1) x 6', expected => [ 'PPI::Structure::List' => '(1)', 'PPI::Token::Structure' => '(', 'PPI::Statement::Expression' => '1', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ')', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '6', ], }, { desc => 'RT 37892: list as arg to x operator 2', code => '(1) x6', expected => [ 'PPI::Structure::List' => '(1)', 'PPI::Token::Structure' => '(', 'PPI::Statement::Expression' => '1', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ')', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '6', ], }, { desc => 'RT 37892: list as arg to x operator 3', code => '(1)x6', expected => [ 'PPI::Structure::List' => '(1)', 'PPI::Token::Structure' => '(', 'PPI::Statement::Expression' => '1', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ')', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '6', ], }, { desc => 'RT 37892: x following function is operator', code => 'foo()x6', expected => [ 'PPI::Token::Word' => 'foo', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '6', ], }, { desc => 'RT 37892: list as arg to x operator 4', code => 'qw(1)x6', expected => [ 'PPI::Token::QuoteLike::Words' => 'qw(1)', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '6', ], }, { desc => 'RT 37892: list as arg to x operator 5', code => 'qw<1>x6', expected => [ 'PPI::Token::QuoteLike::Words' => 'qw<1>', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '6', ], }, { desc => 'RT 37892: listref as arg to x operator 6', code => '[1]x6', expected => [ 'PPI::Structure::Constructor' => '[1]', 'PPI::Token::Structure' => '[', 'PPI::Statement' => '1', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ']', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '6', ], }, { desc => 'x followed by sigil $ that is not also an operator', code => '1x$bar', expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Operator' => 'x', 'PPI::Token::Symbol' => '$bar', ], }, { desc => 'x followed by sigil @ that is not also an operator', code => '1x@bar', expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Operator' => 'x', 'PPI::Token::Symbol' => '@bar', ], }, { desc => 'sub name /^x/', code => 'sub xyzzy : _5x5 {1;}', expected => [ 'PPI::Statement::Sub' => 'sub xyzzy : _5x5 {1;}', 'PPI::Token::Word' => 'sub', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Word' => 'xyzzy', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => ':', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Attribute' => '_5x5', 'PPI::Token::Whitespace' => ' ', 'PPI::Structure::Block' => '{1;}', 'PPI::Token::Structure' => '{', 'PPI::Statement' => '1;', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ';', 'PPI::Token::Structure' => '}', ] }, { desc => 'label plus x', code => 'LABEL: x64', expected => [ 'PPI::Statement::Compound' => 'LABEL:', 'PPI::Token::Label' => 'LABEL:', 'PPI::Token::Whitespace' => ' ', 'PPI::Statement' => 'x64', 'PPI::Token::Word' => 'x64', ] }, ); # Exhaustively test when a preceding operator implies following # 'x' is word not an operator. This detects the regression in # which '$obj->x86_convert()' was being parsed as an x # operator. my %operators = ( %OPERATOR, map { $_ => 1 } qw( -r -w -x -o -R -W -X -O -e -z -s -f -d -l -p -S -b -c -t -u -g -k -T -B -M -A -C ) ); # Don't try to test operators for which PPI currently (1.215) # doesn't recognize when they're followed immediately by a word. # E.g.: # sub x3 {15;} my $z=6; print $z&x3; # sub x3 {3;} my $z=2; print $z%x3; delete $operators{'&'}; delete $operators{'%'}; delete $operators{'*'}; foreach my $operator ( keys %operators ) { my $code = ''; my @expected; if ( $operator =~ /^\w/ ) { $code .= '$a '; push @expected, ( 'PPI::Token::Symbol' => '$a' ); push @expected, ( 'PPI::Token::Whitespace' => ' ' ); } elsif ( $operator !~ /^-\w/ ) { # filetest operators $code .= '$a'; push @expected, ( 'PPI::Token::Symbol' => '$a' ); } $code .= $operator; push @expected, ( ($operator eq '<<>>' || $operator eq '<>' ? 'PPI::Token::QuoteLike::Readline' : 'PPI::Token::Operator') => $operator ); if ( $operator =~ /\w$/ || $operator eq '<<' ) { # want << operator, not heredoc $code .= ' '; push @expected, ( 'PPI::Token::Whitespace' => ' ' ); } $code .= 'x3'; my $desc; if ( $operator eq '--' || $operator eq '++' || $operator eq '<>' || $operator eq '<<>>' ) { push @expected, ( 'PPI::Token::Operator' => 'x' ); push @expected, ( 'PPI::Token::Number' => '3' ); $desc = "operator $operator does not imply following 'x' is a word"; } else { push @expected, ( 'PPI::Token::Word' => 'x3' ); $desc = "operator $operator implies following 'x' is a word"; } push @tests, { desc => $desc, code => $code, expected => \@expected }; } # Test that Perl builtins known to have a null prototype do not # force a following 'x' to be a word. my %noprotos = map { $_ => 1 } qw( endgrent endhostent endnetent endprotoent endpwent endservent fork getgrent gethostent getlogin getnetent getppid getprotoent getpwent getservent setgrent setpwent time times wait wantarray __SUB__ ); foreach my $noproto ( keys %noprotos ) { my $code = "$noproto x3"; my @expected = ( 'PPI::Token::Word' => $noproto, 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '3', ); my $desc = "builtin $noproto does not force following x to be a word"; push @tests, { desc => "builtin $noproto does not force following x to be a word", code => $code, expected => \@expected }; } foreach my $test ( @tests ) { my $d = safe_new \$test->{code}; my $tokens = $d->find( sub { 1; } ); $tokens = [ map { ref($_), $_->content() } @$tokens ]; my $expected = $test->{expected}; if ( $expected->[0] !~ /^PPI::Statement/ ) { unshift @$expected, 'PPI::Statement', $test->{code}; } my $ok = is_deeply( $tokens, $expected, $test->{desc} ); if ( !$ok ) { diag "$test->{code} ($test->{desc})\n"; diag explain $tokens; diag explain $test->{expected}; } } } OPERATOR_FAT_COMMA: { my @tests = ( { desc => 'integer with integer', code => '1 => 2', expected => [ 'PPI::Token::Number' => '1', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => '=>', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '2', ], }, { desc => 'word with integer', code => 'foo => 2', expected => [ 'PPI::Token::Word' => 'foo', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => '=>', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '2', ], }, { desc => 'dashed word with integer', code => '-foo => 2', expected => [ 'PPI::Token::Word' => '-foo', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Operator' => '=>', 'PPI::Token::Whitespace' => ' ', 'PPI::Token::Number' => '2', ], }, ( map { { desc=>$_, code=>"$_=>2", expected=>[ 'PPI::Token::Word' => $_, 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '2', ] } } keys %KEYWORDS ), ( map { { desc=>$_, code=>"($_=>2)", expected=>[ 'PPI::Structure::List' => "($_=>2)", 'PPI::Token::Structure' => '(', 'PPI::Statement::Expression' => "$_=>2", 'PPI::Token::Word' => $_, 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '2', 'PPI::Token::Structure' => ')', ] } } keys %KEYWORDS ), ( map { { desc=>$_, code=>"{$_=>2}", expected=>[ 'PPI::Structure::Constructor' => "{$_=>2}", 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => "$_=>2", 'PPI::Token::Word' => $_, 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '2', 'PPI::Token::Structure' => '}', ] } } keys %KEYWORDS ), ); for my $test ( @tests ) { my $code = $test->{code}; my $d = safe_new \$test->{code}; my $tokens = $d->find( sub { 1; } ); $tokens = [ map { ref($_), $_->content() } @$tokens ]; my $expected = $test->{expected}; if ( $expected->[0] !~ /^PPI::Statement/ ) { unshift @$expected, 'PPI::Statement', $test->{code}; } my $ok = is_deeply( $tokens, $expected, $test->{desc} ); if ( !$ok ) { diag "$test->{code} ($test->{desc})\n"; diag explain $tokens; diag explain $test->{expected}; } } } OPERATORS_PLUS_MINUS: { my @operands = ( '1', '2', '1', '(2)', '(1)', '(2)' ); for my $op (qw/- +/) { for ( my $i = 0; $i < @operands; $i += 2 ) { my ( $a, $b ) = @operands[ $i, $i + 1 ]; my $code = "${a}${op}${b}"; my $doc = safe_new \$code; my $ops = $doc->find('Token::Operator'); is( ref $ops, 'ARRAY', "found operator $op" ); is( @$ops, 1, "operator $op found exactly once" ); is( $ops->[0]->content(), $op, "operator $op text matches" ); } } # Add "'(1)', '2'" into operands once TODO is resolved. { my ( $a, $b ) = ( '(1)', '2' ); my $op = '+'; my $code = "${a}${op}${b}"; my $doc = safe_new \$code; my $ops = $doc->find('Token::Operator'); is( ref $ops, 'ARRAY', "found operator $op" ); } TODO: { my ( $a, $b ) = ( '(1)', '2' ); my $op = '-'; my $code = "${a}${op}${b}"; my $doc = safe_new \$code; my $ops = $doc->find('Token::Operator'); local $TODO = "(1)-2 not parsed correctly"; is( ref $ops, 'ARRAY', "found operator $op" ); } } PPI-1.278/t/12_location.t0000644000175000017500000002303714573465137013375 0ustar olafolaf#!/usr/bin/perl # Tests the accuracy and features for location functionality use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 683 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; my $test_source = <<'END_PERL'; my $foo = 'bar'; # comment sub foo { my ($this, $that) = (<<'THIS', <<"THAT"); foo bar baz THIS foo bar THAT } sub baz { # sub baz contains *tabs* my ($one, $other) = ("one", "other"); # contains 4 tabs foo() ; } sub bar { baz(); #Note that there are leading 4 x space, not 1 x tab in the sub bar bas(); } =head2 fluzz() Print "fluzz". Return 1. =cut sub fluzz { print "fluzz";# line 300 not_at_start_of_line } #line 400 $a # line 500 $b #line600 $c #line 700 filename $d #line 800another-filename $e #line 900 yet-another-filename $f #line 1000"quoted-filename" $g =pod #line 1100 =cut $h =pod #line 1200 =cut $i =pod # line 1300 =cut $j =pod #line1400 =cut $k =pod #line 1500 filename =cut $l =pod #line 1600another-filename =cut $m =pod #line 1700 yet-another-filename =cut $n =pod #line 1800"quoted-filename" =cut $o 1; END_PERL my @test_locations = ( [ 1, 1, 1, 1, undef ], # my [ 1, 3, 3, 1, undef ], # ' ' [ 1, 4, 4, 1, undef ], # $foo [ 1, 8, 8, 1, undef ], # ' ' [ 1, 9, 9, 1, undef ], # = [ 1, 10, 10, 1, undef ], # ' ' [ 1, 11, 11, 1, undef ], # 'bar' [ 1, 16, 16, 1, undef ], # ; [ 1, 17, 17, 1, undef ], # \n [ 2, 1, 1, 2, undef ], # \n [ 3, 1, 1, 3, undef ], # # comment [ 4, 1, 1, 4, undef ], # sub [ 4, 4, 4, 4, undef ], # ' ' [ 4, 5, 5, 4, undef ], # foo [ 4, 8, 8, 4, undef ], # ' ' [ 4, 9, 9, 4, undef ], # { [ 4, 10, 10, 4, undef ], # \n [ 5, 1, 1, 5, undef ], # ' ' [ 5, 5, 5, 5, undef ], # my [ 5, 7, 7, 5, undef ], # ' ' [ 5, 8, 8, 5, undef ], # ( [ 5, 9, 9, 5, undef ], # $this [ 5, 14, 14, 5, undef ], # , [ 5, 15, 15, 5, undef ], # ' ' [ 5, 16, 16, 5, undef ], # $that [ 5, 21, 21, 5, undef ], # ) [ 5, 22, 22, 5, undef ], # ' ' [ 5, 23, 23, 5, undef ], # = [ 5, 24, 24, 5, undef ], # ' ' [ 5, 25, 25, 5, undef ], # ( [ 5, 26, 26, 5, undef ], # <<'THIS' [ 5, 34, 34, 5, undef ], # , [ 5, 35, 35, 5, undef ], # ' ' [ 5, 36, 36, 5, undef ], # <<"THAT" [ 5, 44, 44, 5, undef ], # ) [ 5, 45, 45, 5, undef ], # ; [ 5, 46, 46, 5, undef ], # \n [ 13, 1, 1, 13, undef ], # } [ 13, 2, 2, 13, undef ], # \n [ 14, 1, 1, 14, undef ], # \n [ 15, 1, 1, 15, undef ], # sub [ 15, 4, 4, 15, undef ], # ' ' [ 15, 5, 5, 15, undef ], # baz [ 15, 8, 8, 15, undef ], # ' ' [ 15, 9, 9, 15, undef ], # { [ 15, 10, 10, 15, undef ], # \n [ 16, 1, 1, 16, undef ], # tab# sub baz contains *tabs* [ 17, 1, 1, 17, undef ], # tab [ 17, 2, 5, 17, undef ], # my [ 17, 4, 7, 17, undef ], # ' ' [ 17, 5, 8, 17, undef ], # ( [ 17, 6, 9, 17, undef ], # $one [ 17, 10, 13, 17, undef ], # , [ 17, 11, 14, 17, undef ], # ' ' [ 17, 12, 15, 17, undef ], # $other [ 17, 18, 21, 17, undef ], # ) [ 17, 19, 22, 17, undef ], # ' ' [ 17, 20, 23, 17, undef ], # = [ 17, 21, 24, 17, undef ], # ' tab' [ 17, 23, 29, 17, undef ], # ( [ 17, 24, 30, 17, undef ], # "one" [ 17, 29, 35, 17, undef ], # , [ 17, 30, 36, 17, undef ], # tab [ 17, 31, 37, 17, undef ], # "other" [ 17, 38, 44, 17, undef ], # ) [ 17, 39, 45, 17, undef ], # ; [ 17, 40, 46, 17, undef ], # tab [ 17, 41, 49, 17, undef ], # # contains 3 tabs [ 17, 58, 66, 17, undef ], # \n [ 18, 1, 1, 18, undef ], # \n\t [ 19, 2, 5, 19, undef ], # foo [ 19, 5, 8, 19, undef ], # ( [ 19, 6, 9, 19, undef ], # ) [ 19, 7, 10, 19, undef ], # tab [ 19, 8, 13, 19, undef ], # ; [ 19, 9, 14, 19, undef ], # \n [ 20, 1, 1, 20, undef ], # { [ 20, 2, 2, 20, undef ], # \n [ 21, 1, 1, 21, undef ], # \n [ 22, 1, 1, 22, undef ], # sub [ 22, 4, 4, 22, undef ], # ' ' [ 22, 5, 5, 22, undef ], # bar [ 22, 8, 8, 22, undef ], # ' ' [ 22, 9, 9, 22, undef ], # { [ 22, 10, 10, 22, undef ], # \n [ 23, 1, 1, 23, undef ], # ' ' [ 23, 5, 5, 23, undef ], # baz [ 23, 8, 8, 23, undef ], # ( [ 23, 9, 9, 23, undef ], # ) [ 23, 10, 10, 23, undef ], # ; [ 23, 11, 11, 23, undef ], # \n [ 24, 1, 1, 24, undef ], # \n [ 25, 1, 1, 25, undef ], # #Note that there are leading 4 x space, ... [ 26, 1, 1, 26, undef ], # '\n ' [ 27, 5, 5, 27, undef ], # bas [ 27, 8, 8, 27, undef ], # ( [ 27, 9, 9, 27, undef ], # ) [ 27, 10, 10, 27, undef ], # ; [ 27, 11, 11, 27, undef ], # \n [ 28, 1, 1, 28, undef ], # } [ 28, 2, 2, 28, undef ], # \n [ 29, 1, 1, 29, undef ], # \n [ 30, 1, 1, 30, undef ], # =head2 fluzz() ... [ 35, 1, 1, 35, undef ], # sub [ 35, 4, 4, 35, undef ], # ' ' [ 35, 5, 5, 35, undef ], # fluzz [ 35, 10, 10, 35, undef ], # ' ' [ 35, 11, 11, 35, undef ], # { [ 35, 12, 12, 35, undef ], # \n [ 36, 1, 1, 36, undef ], # ' ' [ 36, 5, 5, 36, undef ], # print [ 36, 10, 10, 36, undef ], # ' ' [ 36, 11, 11, 36, undef ], # "fluzz" [ 36, 18, 18, 36, undef ], # ; [ 36, 19, 19, 36, undef ], # # line 300 not_at_start_of_line [ 36, 50, 50, 36, undef ], # \n [ 37, 1, 1, 37, undef ], # } [ 37, 2, 2, 37, undef ], # \n [ 38, 1, 1, 38, undef ], # \n [ 39, 1, 1, 39, undef ], # #line 400 [ 40, 1, 1, 400, undef ], # $a [ 40, 3, 3, 400, undef ], # \n [ 41, 1, 1, 401, undef ], # # line 500 [ 42, 1, 1, 500, undef ], # $b [ 42, 3, 3, 500, undef ], # \n # No space between "line" and number causes it to not work. [ 43, 1, 1, 501, undef ], # #line600 [ 44, 1, 1, 502, undef ], # $c [ 44, 3, 3, 502, undef ], # \n [ 45, 1, 1, 503, undef ], # #line 700 filename [ 46, 1, 1, 700, 'filename' ], # $d [ 46, 3, 3, 700, 'filename' ], # \n [ 47, 1, 1, 701, 'filename' ], # #line 800another-filename [ 48, 1, 1, 800, 'another-filename' ], # $e [ 48, 3, 3, 800, 'another-filename' ], # \n [ 49, 1, 1, 801, 'another-filename' ], # #line 900 yet-another-filename [ 50, 1, 1, 900, 'yet-another-filename' ], # $f [ 50, 3, 3, 900, 'yet-another-filename' ], # \n [ 51, 1, 1, 901, 'yet-another-filename' ], # #line 1000"quoted-filename" [ 52, 1, 1, 1000, 'quoted-filename' ], # $g [ 52, 3, 3, 1000, 'quoted-filename' ], # \n [ 53, 1, 1, 1001, 'quoted-filename' ], # \n [ 54, 1, 1, 1002, 'quoted-filename' ], # =pod #line 1100 (not in column 1) [ 59, 1, 1, 1007, 'quoted-filename' ], # $h [ 59, 3, 3, 1007, 'quoted-filename' ], # \n [ 60, 1, 1, 1008, 'quoted-filename' ], # =pod #line 1200 [ 65, 1, 1, 1202, 'quoted-filename' ], # $i [ 65, 3, 3, 1202, 'quoted-filename' ], # \n [ 66, 1, 1, 1203, 'quoted-filename' ], # =pod # line 1300 [ 71, 1, 1, 1302, 'quoted-filename' ], # $j [ 71, 3, 3, 1302, 'quoted-filename' ], # \n # No space between "line" and number causes it to not work. [ 72, 1, 1, 1303, 'quoted-filename' ], # =pod #line1400 [ 77, 1, 1, 1308, 'quoted-filename' ], # $k [ 77, 3, 3, 1308, 'quoted-filename' ], # \n [ 78, 1, 1, 1309, 'quoted-filename' ], # =pod #line 1500 filename [ 83, 1, 1, 1502, 'filename' ], # $l [ 83, 3, 3, 1502, 'filename' ], # \n [ 84, 1, 1, 1503, 'filename' ], # =pod #line 1600another-filename [ 89, 1, 1, 1602, 'another-filename' ], # $m [ 89, 3, 3, 1602, 'another-filename' ], # \n [ 90, 1, 1, 1603, 'another-filename' ], # =pod #line 1700 yet-another-filename [ 95, 1, 1, 1702, 'yet-another-filename' ], # $n [ 95, 3, 3, 1702, 'yet-another-filename' ], # \n [ 96, 1, 1, 1703, 'yet-another-filename' ], # =pod #line 1800"quoted-filename" [ 101, 1, 1, 1802, 'quoted-filename' ], # $o [ 101, 3, 3, 1802, 'quoted-filename' ], # \n [ 102, 1, 1, 1803, 'quoted-filename' ], # \n [ 103, 1, 1, 1804, 'quoted-filename' ], # 1 [ 103, 2, 2, 1804, 'quoted-filename' ], # ; [ 103, 3, 3, 1804, 'quoted-filename' ], # \n ); ##################################################################### # Test the locations of everything in the test code # Prepare my $Document = safe_new \$test_source; $Document->tab_width(4); is($Document->tab_width, 4, 'Tab width set correctly'); ok( $Document->index_locations, '->index_locations returns true' ); # Now check the locations of every token my @tokens = $Document->tokens; is( scalar(@tokens), scalar(@test_locations), 'Number of tokens matches expected' ); foreach my $i ( 0 .. $#test_locations ) { my $location = $tokens[$i]->location; is( ref($location), 'ARRAY', "Token $i: ->location returns an ARRAY ref" ); is( scalar(@$location), 5, "Token $i: ->location returns a 5 element ARRAY ref" ); ok( ( $location->[0] > 0 and $location->[1] > 0 and $location->[2] > 0 and $location->[3] > 0 ), "Token $i: ->location returns four positive positions" ); is_deeply( $tokens[$i]->location, $test_locations[$i], "Token $i: ->location matches expected", ); } ok( $Document->flush_locations, '->flush_locations returns true' ); is( scalar(grep { defined $_->{_location} } $Document->tokens), 0, 'All _location attributes removed' ); PPI-1.278/t/ppi_token_attribute.t0000644000175000017500000001135614573465137015337 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Attribute use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 2235 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; sub execute_test; sub permute_test; PARSING_AND_METHODS: { # no attribute execute_test 'sub foo {}', []; execute_test 'sub foo;', []; # perl allows there to be no attributes following the colon. execute_test 'sub foo:{}', []; execute_test 'sub foo : {}', []; # Attribute with no parameters permute_test 'foo', [ [ 'Attr1', undef ] ]; permute_test 'foo', [ [ 'Attr1', undef ] ]; permute_test 'foo', [ [ 'Attr1', undef ] ]; permute_test 'method', [ [ 'Attr1', undef ] ]; permute_test 'lvalue', [ [ 'Attr1', undef ] ]; permute_test 'foo', [ [ '_', undef ] ]; # Attribute with parameters permute_test 'foo', [ [ 'Attr1', '' ] ]; permute_test 'foo', [ [ 'Attr1', ' ' ] ]; permute_test 'foo', [ [ 'Attr1', ' () ' ] ]; permute_test 'foo', [ [ 'Attr1', ' (()) ' ] ]; permute_test 'foo', [ [ 'Attr1', ' \) ' ] ]; permute_test 'foo', [ [ 'Attr1', ' \( ' ] ]; permute_test 'foo', [ [ 'Attr1', '{' ] ]; permute_test 'foo', [ [ '_', '' ] ]; # Multiple attributes, separated by colon+whitespace permute_test 'foo', [ [ 'Attr1', undef ], [ 'Attr2', undef ] ]; permute_test 'foo', [ [ 'Attr1', undef ], [ 'Attr2', undef ] ]; permute_test 'foo', [ [ 'Attr1', undef ], [ 'Attr2', undef ] ]; permute_test 'foo', [ [ 'Attr1', undef ], [ 'Attr2', undef ], [ 'Attr3', undef ] ]; permute_test 'foo', [ [ 'Attr1', '' ], [ 'Attr2', '' ], [ 'Attr3', '' ] ]; permute_test 'foo', [ [ 'Attr1', '' ], [ 'Attr2', '___' ], [ 'Attr3', '' ] ]; # Multiple attributes, separated by whitespace only permute_test 'foo', [ [ 'Attr1', undef ], [ 'Attr2', undef ] ]; permute_test 'foo', [ [ 'Attr1', 'a' ], [ 'Attr2', 'b' ] ]; # Examples from perldoc attributes permute_test 'foo', [ [ 'switch', '10,foo(7,3)' ], [ 'expensive', undef ] ]; permute_test 'foo', [ [ 'Ugly', '\'\\("' ], [ 'Bad', undef ] ]; permute_test 'foo', [ [ '_5x5', undef ] ]; permute_test 'foo', [ [ 'lvalue', undef ], [ 'method', undef ] ]; # Mixed separators execute_test 'sub foo : Attr1(a) Attr2(b) : Attr3(c) Attr4(d) {}', [ [ 'Attr1', 'a' ], [ 'Attr2', 'b' ], [ 'Attr3', 'c' ], [ 'Attr4', 'd' ] ]; # When PPI supports anonymous subs, we'll need tests for # attributes on them, too. } sub execute_test { my ( $code, $expected, $msg ) = @_; $msg = $code if !defined $msg; my $Document = safe_new \$code; my $attributes = $Document->find( 'PPI::Token::Attribute') || []; is( scalar(@$attributes), scalar(@$expected), "'$msg' got expected number of attributes" ); is_deeply( [ map { [ $_->identifier, $_->parameters ] } @$attributes ], $expected, "'$msg' attribute properties as expected" ); my $blocks = $Document->find( 'PPI::Structure::Block') || []; my $blocks_expected = $code =~ m/{}$/ ? [ '{}' ] : []; is_deeply( [ map { $_->content } @$blocks ], $blocks_expected, "$msg blocks found as expected" ); return; } sub assemble_and_run { my ( $name, $post_colon, $separator, $attributes, $post_attributes, $block ) = @_; $block = '{}' if !defined $block; my $attribute_str = join $separator, map { defined $_->[1] ? "$_->[0]($_->[1])" : $_->[0] } @$attributes; my $code = "sub $name :$post_colon$attribute_str$post_attributes$block"; my $msg = $code; $msg =~ s|\x{b}|\\v|g; $msg =~ s|\t|\\t|g; $msg =~ s|\r|\\r|g; $msg =~ s|\n|\\n|g; $msg =~ s|\f|\\f|g; execute_test $code, $attributes, $msg; return; } sub permute_test { my ( $name, $attributes ) = @_; # Vertical tab \x{b} is whitespace since perl 5.20, but PPI currently # (1.220) only supports it as whitespace when running on 5.20 # or greater. assemble_and_run $name, '', ':', $attributes, '', '{}'; assemble_and_run $name, '', ':', $attributes, '', ';'; assemble_and_run $name, ' ', ' ', $attributes, ' ', '{}'; assemble_and_run $name, ' ', "\t", $attributes, ' ', '{}'; assemble_and_run $name, ' ', "\r", $attributes, ' ', '{}'; assemble_and_run $name, ' ', "\n", $attributes, ' ', '{}'; assemble_and_run $name, ' ', "\f", $attributes, ' ', '{}'; assemble_and_run $name, "\t", "\t", $attributes, "\t", '{}'; assemble_and_run $name, "\t", "\t", $attributes, "\t", ';'; assemble_and_run $name, "\r", "\r", $attributes, "\r", '{}'; assemble_and_run $name, "\n", "\n", $attributes, "\n", '{}'; assemble_and_run $name, "\f", "\f", $attributes, "\f", '{}'; assemble_and_run $name, "\f", "\f", $attributes, "\f", ';'; assemble_and_run $name, "\t", "\t:\t", $attributes, "\t", '{}'; assemble_and_run $name, "\r", "\r:\r", $attributes, "\r", '{}'; assemble_and_run $name, "\n", "\n:\n", $attributes, "\n", '{}'; assemble_and_run $name, "\f", "\f:\f", $attributes, "\f", '{}'; return; } PPI-1.278/t/29_logical_filename.t0000644000175000017500000000406114573465137015043 0ustar olafolaf#!/usr/bin/perl # Testing of PPI::Element->logical_filename use strict; BEGIN { no warnings 'once'; $| = 1; $PPI::XS_DISABLE = 1; $PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER}; } use File::Spec::Functions qw( catfile ); use PPI::Document (); use PPI::Document::File (); use PPI::Util (); use Test::More tests => 20 + 1; # Test::NoWarnings use Test::NoWarnings; ## no perlimports for my $class ( ( PPI::Document::, PPI::Document::File:: ) ) { ##################################################################### # Actual filename is used until #line directive SCOPE: { my $file = catfile('t', 'data', 'filename.pl'); ok( -f $file, "$class, test file" ); my $doc = $class->new( $file ); my $items = $doc->find( 'Token::Quote' ); is( @$items + 0, 2, "$class, number of items" ); is( $items->[ 0 ]->logical_filename, "$file", "$class, filename" ); is( $items->[ 1 ]->logical_filename, "moo.pl", "$class, filename" ); } ##################################################################### # filename attribute overrides actual filename SCOPE: { my $file = catfile('t', 'data', 'filename.pl'); ok( -f $file, "$class, test file" ); my $doc = $class->new( $file, filename => 'assa.pl' ); my $items = $doc->find( 'Token::Quote' ); is( @$items + 0, 2, "$class, number of items" ); my $str = $items->[ 0 ]; is( $items->[ 0 ]->logical_filename, "assa.pl", "$class, filename" ); is( $items->[ 1 ]->logical_filename, "moo.pl", "$class, filename" ); } } ##################################################################### # filename attribute works for strings too SCOPE: { my $class = 'PPI::Document'; my $file = catfile('t', 'data', 'filename.pl'); ok( -f $file, "$class, test file" ); my $text = PPI::Util::_slurp( $file ); my $doc = $class->new( $text, filename => 'tadam.pl' ); my $items = $doc->find( 'Token::Quote' ); is( @$items + 0, 2, "$class, number of items" ); my $str = $items->[ 0 ]; is( $items->[ 0 ]->logical_filename, "tadam.pl", "$class, filename" ); is( $items->[ 1 ]->logical_filename, "moo.pl", "$class, filename" ); } PPI-1.278/t/10_statement.t0000644000175000017500000000125114573465137013561 0ustar olafolaf#!/usr/bin/perl # Test the various PPI::Statement packages use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 7 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; ##################################################################### # Basic subroutine test SCOPE: { my $doc = safe_new \"sub foo { 1 }"; isa_ok( $doc->child(0), 'PPI::Statement::Sub' ); } ##################################################################### # Regression test, make sure utf8 is a pragma SCOPE: { my $doc = safe_new \"use utf8;"; isa_ok( $doc->child(0), 'PPI::Statement::Include' ); is( $doc->child(0)->pragma, 'utf8', 'use utf8 is a pragma' ); } PPI-1.278/t/27_complete.t0000644000175000017500000000202314573465137013373 0ustar olafolaf#!/usr/bin/perl # Testing for the PPI::Document ->complete method use lib 't/lib'; use PPI::Test::pragmas; use Test::More; # Plan comes later use File::Spec::Functions qw( catdir ); use PPI (); use PPI::Test qw( find_files ); use Helper 'safe_new'; # This test uses a series of ordered files, containing test code. # The letter after the number acts as a boolean yes/no answer to # "Is this code complete" my @files = find_files( catdir( 't', 'data', '27_complete' ) ); my $tests = (scalar(@files) * 3) + 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); plan( tests => $tests ); ##################################################################### # Resource Location ok( scalar(@files), 'Found at least one ->complete test file' ); foreach my $file ( @files ) { # Load the document my $document = safe_new $file; # Test if complete or not my $got = !! ($document->complete); my $expected = !! ($file =~ /\d+y\w+\.code$/); my $isnot = ($got == $expected) ? 'is' : 'is NOT'; is( $got, $expected, "File $file $isnot complete" ); } PPI-1.278/t/ppi_token_prototype.t0000644000175000017500000000461314573465137015377 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Prototype use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 120 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); use PPI (); use Helper 'safe_new'; sub check; sub check_w_subs; PARSING: { my @sub_patterns; for my $block ( '{1;}', ';' ) { push @sub_patterns, # map [ $_, $block ], 'sub foo', 'sub', 'sub AUTOLOAD', 'sub DESTROY'; } check_w_subs \@sub_patterns, '', '', ''; check_w_subs \@sub_patterns, '()', '()', ''; check_w_subs \@sub_patterns, '( )', '( )', ''; check_w_subs \@sub_patterns, ' () ',, '()', ''; check_w_subs \@sub_patterns, '(+@)', '(+@)', '+@'; check_w_subs \@sub_patterns, ' (+@) ', '(+@)', '+@'; check_w_subs \@sub_patterns, '(\[$;$_@])', '(\[$;$_@])', '\[$;$_@]'; check_w_subs \@sub_patterns, '(\ [ $ ])', '(\ [ $ ])', '\[$]'; ## nonsense, but perl accepts it check_w_subs \@sub_patterns, '(\\\ [ $ ])', '(\\\ [ $ ])', '\\\[$]'; check_w_subs \@sub_patterns, '($ _ %)', '($ _ %)', '$_%'; ## invalid chars in prototype check_w_subs \@sub_patterns, '( Z)', '( Z)', 'Z'; ## invalid chars in prototype check_w_subs \@sub_patterns, '(!-=|)', '(!-=|)', '!-=|'; ## perl refuses to compile this check_w_subs \@sub_patterns, '(()', '(()', '(', 1; check_w_subs \@sub_patterns, '((a))', '((a))', '(a)'; check_w_subs \@sub_patterns, # "(\n(\na\n)\n)", "(\n(\na\n)\n)", "(a)"; } sub check_w_subs { local $Test::Builder::Level = $Test::Builder::Level + 1; check @{$_}, @_ for @{ shift() }; return; } sub check { local $Test::Builder::Level = $Test::Builder::Level + 1; my ( $name, $block, $code_prototype, $expected_content, $expected_prototype, $tail ) = @_; my $desc = my $code = "$name$code_prototype$block"; $desc =~ s/\n/\\n/g; subtest $desc => sub { my $document = safe_new \$code; my $all_prototypes = $document->find('PPI::Token::Prototype'); return is $all_prototypes, "", "got no prototypes" if $code_prototype eq ''; $all_prototypes = [] if !ref $all_prototypes; is scalar(@$all_prototypes), 1, "got exactly one prototype"; my $prototype_obj = $all_prototypes->[0]; is $prototype_obj, $expected_content . ( $tail ? $block : "" ), "prototype object content matches"; is $prototype_obj->prototype, $expected_prototype . ( $tail ? ")$block" : "" ), "prototype characters match"; }; return; } PPI-1.278/t/ppi_token_number_version.t0000644000175000017500000000512714573465137016370 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Number::Version use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 2187 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Singletons qw( %KEYWORDS %OPERATOR %QUOTELIKE ); use Helper 'safe_new'; LITERAL: { my $doc1 = new_ok( 'PPI::Document' => [ \'1.2.3.4' ] ); my $doc2 = new_ok( 'PPI::Document' => [ \'v1.2.3.4' ] ); isa_ok( $doc1->child(0), 'PPI::Statement' ); isa_ok( $doc2->child(0), 'PPI::Statement' ); isa_ok( $doc1->child(0)->child(0), 'PPI::Token::Number::Version' ); isa_ok( $doc2->child(0)->child(0), 'PPI::Token::Number::Version' ); my $literal1 = $doc1->child(0)->child(0)->literal; my $literal2 = $doc2->child(0)->child(0)->literal; is( length($literal1), 4, 'The literal length of doc1 is 4' ); is( length($literal2), 4, 'The literal length of doc1 is 4' ); is( $literal1, $literal2, 'Literals match for 1.2.3.4 vs v1.2.3.4' ); } VSTRING_ENDS_CORRECTLY: { my @tests = ( ( map { { desc=>"no . in 'v49$_', so not a version string", code=>"v49$_", expected=>[ 'PPI::Token::Word' => "v49$_" ], } } ( 'x3', # not fooled by faux x operator with operand 'e10', # not fooled by faux scientific notation keys %KEYWORDS, ), ), ( map { { desc => "version string in 'v49.49$_' stops after number", code => "v49.49$_", expected => [ 'PPI::Token::Number::Version' => 'v49.49', get_class($_) => $_, ], }, } ( keys %KEYWORDS, ), ), ( map { { desc => "version string in '49.49.49$_' stops after number", code => "49.49.49$_", expected => [ 'PPI::Token::Number::Version' => '49.49.49', get_class($_) => $_, ], }, } ( keys %KEYWORDS, ), ), { desc => 'version string, x, and operand', code => 'v49.49.49x3', expected => [ 'PPI::Token::Number::Version' => 'v49.49.49', 'PPI::Token::Operator' => 'x', 'PPI::Token::Number' => '3', ], }, ); for my $test ( @tests ) { my $code = $test->{code}; my $d = safe_new \$test->{code}; my $tokens = $d->find( sub { 1; } ); $tokens = [ map { ref($_), $_->content() } @$tokens ]; my $expected = $test->{expected}; unshift @$expected, 'PPI::Statement', $test->{code}; my $ok = is_deeply( $tokens, $expected, $test->{desc} ); if ( !$ok ) { diag "$test->{code} ($test->{desc})\n"; diag explain $tokens; diag explain $test->{expected}; } } } sub get_class { my ( $t ) = @_; my $ql = $QUOTELIKE{$t}; return "PPI::Token::$ql" if $ql; return 'PPI::Token::Operator' if $OPERATOR{$t}; return 'PPI::Token::Word'; } PPI-1.278/t/ppi_token_heredoc.t0000644000175000017500000003120314573465137014736 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::HereDoc use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 30 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; sub h; # List of tests to perform. Each test requires the following information: # - 'name': the name of the test in the output. # - 'content': the Perl string to parse using PPI. # - 'expected': a hashref with the keys being property names on the # PPI::Token::HereDoc object, and the values being the expected value of # that property after the heredoc block has been parsed. Key 'heredoc' # is a special case, and is an array ref holding the expected value of # heredoc(), and defaulting to [ "Line 1\n", "Line 2\n" ]. # Tests with a carriage return after the termination marker. h { name => 'Bareword terminator.', content => "my \$heredoc = < { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'interpolate', _indented => undef, _indentation => undef, }, }; h { name => 'Single-quoted bareword terminator.', content => "my \$heredoc = <<'HERE';\nLine 1\nLine 2\nHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'literal', _indented => undef, _indentation => undef, }, }; h { name => 'Single-quoted bareword terminator with space.', content => "my \$heredoc = << 'HERE';\nLine 1\nLine 2\nHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'literal', _indented => undef, _indentation => undef, }, }; h { name => 'Double-quoted bareword terminator.', content => "my \$heredoc = <<\"HERE\";\nLine 1\nLine 2\nHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'interpolate', _indented => undef, _indentation => undef, }, }; h { name => 'Double-quoted bareword terminator with space.', content => "my \$heredoc = << \"HERE\";\nLine 1\nLine 2\nHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'interpolate', _indented => undef, _indentation => undef, }, }; h { name => 'Command-quoted terminator.', content => "my \$heredoc = <<`HERE`;\nLine 1\nLine 2\nHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'command', _indented => undef, _indentation => undef, }, }; h { name => 'Command-quoted terminator with space.', content => "my \$heredoc = << `HERE`;\nLine 1\nLine 2\nHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'command', _indented => undef, _indentation => undef, }, }; h { name => 'Legacy escaped bareword terminator.', content => "my \$heredoc = <<\\HERE;\nLine 1\nLine 2\nHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'literal', _indented => undef, _indentation => undef, }, }; # Tests without a carriage return after the termination marker. h { name => 'Bareword terminator (no return).', content => "my \$heredoc = < { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'interpolate', _indented => undef, _indentation => undef, }, }; h { name => 'Single-quoted bareword terminator (no return).', content => "my \$heredoc = <<'HERE';\nLine 1\nLine 2\nHERE", expected => { _terminator_line => "HERE", _damaged => 1, _terminator => 'HERE', _mode => 'literal', _indented => undef, _indentation => undef, }, }; h { name => 'Double-quoted bareword terminator (no return).', content => "my \$heredoc = <<\"HERE\";\nLine 1\nLine 2\nHERE", expected => { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'interpolate', _indented => undef, _indentation => undef, }, }; h { name => 'Command-quoted terminator (no return).', content => "my \$heredoc = <<`HERE`;\nLine 1\nLine 2\nHERE", expected => { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'command', _indented => undef, _indentation => undef, }, }; h { name => 'Legacy escaped bareword terminator (no return).', content => "my \$heredoc = <<\\HERE;\nLine 1\nLine 2\nHERE", expected => { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'literal', _indented => undef, _indentation => undef, }, }; # Tests without a terminator. h { name => 'Unterminated heredoc block.', content => "my \$heredoc = < { _terminator_line => undef, _damaged => 1, _terminator => 'HERE', _mode => 'interpolate', _indented => undef, _indentation => undef, }, }; # Tests indented here-document with a carriage return after the termination marker. h { name => 'Bareword terminator (indented).', content => "my \$heredoc = <<~HERE;\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Single-quoted bareword terminator (indented).', content => "my \$heredoc = <<~'HERE';\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'literal', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Single-quoted bareword terminator with space (indented).', content => "my \$heredoc = <<~ 'HERE';\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'literal', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Double-quoted bareword terminator (indented).', content => "my \$heredoc = <<~\"HERE\";\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Double-quoted bareword terminator with space (indented).', content => "my \$heredoc = <<~ \"HERE\";\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Command-quoted terminator (indented).', content => "my \$heredoc = <<~`HERE`;\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'command', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Command-quoted terminator with space (indented).', content => "my \$heredoc = <<~ `HERE`;\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'command', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Legacy escaped bareword terminator (indented).', content => "my \$heredoc = <<~\\HERE;\n\t \tLine 1\n\t \tLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'literal', _indented => 1, _indentation => "\t \t", }, }; # Tests indented here-document without a carriage return after the termination marker. h { name => 'Bareword terminator (indented and no return).', content => "my \$heredoc = <<~HERE;\n\t \tLine 1\n\t \tLine 2\n\t \tHERE", expected => { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Single-quoted bareword terminator (indented and no return).', content => "my \$heredoc = <<~'HERE';\n\t \tLine 1\n\t \tLine 2\n\t \tHERE", expected => { _terminator_line => "HERE", _damaged => 1, _terminator => 'HERE', _mode => 'literal', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Double-quoted bareword terminator (indented and no return).', content => "my \$heredoc = <<~\"HERE\";\n\t \tLine 1\n\t \tLine 2\n\t \tHERE", expected => { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Command-quoted terminator (indented and no return).', content => "my \$heredoc = <<~`HERE`;\n\t \tLine 1\n\t \tLine 2\n\t \tHERE", expected => { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'command', _indented => 1, _indentation => "\t \t", }, }; h { name => 'Legacy escaped bareword terminator (indented and no return).', content => "my \$heredoc = <<~\\HERE;\n\t \tLine 1\n\t \tLine 2\n\t \tHERE", expected => { _terminator_line => 'HERE', _damaged => 1, _terminator => 'HERE', _mode => 'literal', _indented => 1, _indentation => "\t \t", }, }; # Tests indented here-document without a terminator. h { name => 'Unterminated heredoc block (indented).', content => "my \$heredoc = <<~HERE;\nLine 1\nLine 2\n", expected => { _terminator_line => undef, _damaged => 1, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, _indentation => undef, }, }; # Tests indented here-document where indentation doesn't match h { name => 'Unterminated heredoc block (indented).', content => "my \$heredoc = <<~HERE;\nLine 1\nLine 2\n\t \tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => 1, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, _indentation => "\t \t", }, }; # Tests indented here-document with empty line h { name => 'Indented heredoc with empty line.', content => "my \$heredoc = <<~HERE;\n\tLine 1\n\n\tLine 3\n\tHERE\n", expected => { _terminator_line => "HERE\n", _damaged => undef, _terminator => 'HERE', _mode => 'interpolate', _indented => 1, heredoc => [ "Line 1\n", "\n", "Line 3\n" ], _indentation => "\t", }, }; sub h { my ( $test ) = @_; my %exception = map { $_ => 1 } qw{ heredoc }; subtest( $test->{name}, sub { my $exceptions = grep { $exception{$_} } keys %{ $test->{expected} }; plan tests => 8 - $exceptions + keys %{ $test->{expected} }; my $document = safe_new \$test->{content}; SKIP: { skip 'Damaged document', 1 if $test->{expected}{_damaged}; is( $document->serialize(), $test->{content}, 'Document serializes correctly' ); } my $heredocs = $document->find( 'Token::HereDoc' ); is( ref $heredocs, 'ARRAY', 'Found heredocs.' ); is( scalar @$heredocs, 1, 'Found 1 heredoc block.' ); my $heredoc = $heredocs->[0]; isa_ok( $heredoc, 'PPI::Token::HereDoc' ); can_ok( $heredoc, 'heredoc' ); my @content = $heredoc->heredoc; my @expected_heredoc = @{ $test->{expected}{heredoc} || [ "Line 1\n", "Line 2\n", ] }; is_deeply( \@content, \@expected_heredoc, 'The returned content does not include the heredoc terminator.', ) or diag "heredoc() returned ", explain \@content; is( $heredoc->{$_}, $test->{expected}{$_}, "property '$_'" ) for grep { ! $exception{$_} } keys %{ $test->{expected} }; } ); } PPI-1.278/t/04_element.t0000644000175000017500000005072314573465137013221 0ustar olafolaf#!/usr/bin/perl # Formal testing for PPI # This does an empiric test that when we try to parse something, # something ( anything ) comes out the other side. use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 227 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Singletons qw( %_PARENT ); use PPI::Test qw( pause ); use Scalar::Util qw( refaddr ); use Helper 'safe_new'; my $RE_IDENTIFIER = qr/[^\W\d]\w*/; sub is_object { my ($left, $right, $message) = @_; $message ||= "Objects match"; my $condition = ( defined $left and ref $left, and defined $right, and ref $right, and refaddr($left) == refaddr($right) ); ok( $condition, $message ); } sub omethod_fails { my $object = ref($_[0])->isa('UNIVERSAL') ? shift : die "Failed to pass method_fails test an object"; my $method = (defined $_[0] and $_[0] =~ /$RE_IDENTIFIER/o) ? shift : die "Failed to pass method_fails an identifier"; my $arg_set = ( ref $_[0] eq 'ARRAY' and scalar(@{$_[0]}) ) ? shift : die "Failed to pass method_fails a set of arguments"; foreach my $args ( @$arg_set ) { is( $object->$method( $args ), undef, ref($object) . "->$method fails correctly" ); } } ##################################################################### # Miscellaneous # Confirm that C< weaken( $hash{scalar} = $object ) > works as expected, # adding a weak reference to the has index. use Scalar::Util qw( refaddr ); SCOPE: { my %hash; my $counter = 0; SCOPE: { my $object1 = bless { }, 'My::WeakenTest'; my $object2 = bless { }, 'My::WeakenTest'; my $object3 = bless { }, 'My::WeakenTest'; isa_ok( $object1, 'My::WeakenTest' ); isa_ok( $object2, 'My::WeakenTest' ); isa_ok( $object3, 'My::WeakenTest' ); # Do nothing for object1. # Add object2 to a has index normally $hash{foo} = $object2; # Add object2 and weaken Scalar::Util::weaken($hash{bar} = $object3); ok( Scalar::Util::isweak( $hash{bar} ), 'index entry is weak' ); ok( ! Scalar::Util::isweak( $object3 ), 'original is not weak' ); pause(); # Do all the objects still exist isa_ok( $object1, 'My::WeakenTest' ); isa_ok( $object2, 'My::WeakenTest' ); isa_ok( $object3, 'My::WeakenTest' ); isa_ok( $hash{foo}, 'My::WeakenTest' ); isa_ok( $hash{bar}, 'My::WeakenTest' ); } pause(); # Two of the three should have destroyed is( $counter, 2, 'Counter increments as expected normally' ); # foo should still be there isa_ok( $hash{foo}, 'My::WeakenTest' ); # bar should ->exists, but be undefined ok( exists $hash{bar}, 'weakened object hash slot exists' ); ok( ! defined $hash{bar}, 'weakened object hash slot is undefined' ); package My::WeakenTest; sub DESTROY { $counter++; } } # Test interaction between weaken and Clone SCOPE: { my $object = { a => undef }; # my $object = bless { a => undef }, 'Foo'; my $object2 = $object; Scalar::Util::weaken($object2); my $clone = Clone::clone($object); is_deeply( $clone, $object, 'Object is cloned OK when a different reference is weakened' ); } ##################################################################### # Prepare # Build a basic source tree to test with my $source = 'my@foo = (1, 2);'; my $Document = PPI::Lexer->lex_source( $source ); isa_ok( $Document, 'PPI::Document' ); is( $Document->content, $source, "Document round-trips ok" ); is( scalar($Document->tokens), 12, "Basic source contains the correct number of tokens" ); is( scalar(@{$Document->{children}}), 1, "Document contains one element" ); my $Statement = $Document->{children}->[0]; isa_ok( $Statement, 'PPI::Statement' ); isa_ok( $Statement, 'PPI::Statement::Variable' ); is( scalar(@{$Statement->{children}}), 7, "Statement contains the correct number of elements" ); my $Token1 = $Statement->{children}->[0]; my $Token2 = $Statement->{children}->[1]; my $Token3 = $Statement->{children}->[2]; my $Braces = $Statement->{children}->[5]; my $Token7 = $Statement->{children}->[6]; isa_ok( $Token1, 'PPI::Token::Word' ); isa_ok( $Token2, 'PPI::Token::Symbol' ); isa_ok( $Token3, 'PPI::Token::Whitespace' ); isa_ok( $Braces, 'PPI::Structure::List' ); isa_ok( $Token7, 'PPI::Token::Structure' ); ok( ($Token1->isa('PPI::Token::Word') and $Token1->content eq 'my'), 'First token is correct' ); ok( ($Token2->isa('PPI::Token::Symbol') and $Token2->content eq '@foo'), 'Second token is correct' ); ok( ($Token3->isa('PPI::Token::Whitespace') and $Token3->content eq ' '), 'Third token is correct' ); is( $Braces->braces, '()', 'Braces seem correct' ); ok( ($Token7->isa('PPI::Token::Structure') and $Token7->content eq ';'), 'Seventh token is correct' ); isa_ok( $Braces->start, 'PPI::Token::Structure' ); ok( ($Braces->start->isa('PPI::Token::Structure') and $Braces->start->content eq '('), 'Start brace token matches expected' ); isa_ok( $Braces->finish, 'PPI::Token::Structure' ); ok( ($Braces->finish->isa('PPI::Token::Structure') and $Braces->finish->content eq ')'), 'Finish brace token matches expected' ); ##################################################################### # Testing of PPI::Element basic information methods # Testing the ->content method is( $Document->content, $source, "Document content is correct" ); is( $Statement->content, $source, "Statement content is correct" ); is( $Token1->content, 'my', "Token content is correct" ); is( $Token2->content, '@foo', "Token content is correct" ); is( $Token3->content, ' ', "Token content is correct" ); is( $Braces->content, '(1, 2)', "Token content is correct" ); is( $Token7->content, ';', "Token content is correct" ); # Testing the ->tokens method is( scalar($Document->tokens), 12, "Document token count is correct" ); is( scalar($Statement->tokens), 12, "Statement token count is correct" ); isa_ok( $Token1->tokens, 'PPI::Token', "Token token count is correct" ); isa_ok( $Token2->tokens, 'PPI::Token', "Token token count is correct" ); isa_ok( $Token3->tokens, 'PPI::Token', "Token token count is correct" ); is( scalar($Braces->tokens), 6, "Token token count is correct" ); isa_ok( $Token7->tokens, 'PPI::Token', "Token token count is correct" ); # Testing the ->significant method is( $Document->significant, 1, 'Document is significant' ); is( $Statement->significant, 1, 'Statement is significant' ); is( $Token1->significant, 1, 'Token is significant' ); is( $Token2->significant, 1, 'Token is significant' ); is( $Token3->significant, '', 'Token is significant' ); is( $Braces->significant, 1, 'Token is significant' ); is( $Token7->significant, 1, 'Token is significant' ); ##################################################################### # Testing of PPI::Element navigation # Test the ->parent method is( $Document->parent, undef, "Document does not have a parent" ); is_object( $Statement->parent, $Document, "Statement sees document as parent" ); is_object( $Token1->parent, $Statement, "Token sees statement as parent" ); is_object( $Token2->parent, $Statement, "Token sees statement as parent" ); is_object( $Token3->parent, $Statement, "Token sees statement as parent" ); is_object( $Braces->parent, $Statement, "Braces sees statement as parent" ); is_object( $Token7->parent, $Statement, "Token sees statement as parent" ); # Test the special case of parents for the Braces opening and closing braces is_object( $Braces->start->parent, $Braces, "Start brace sees the PPI::Structure as its parent" ); is_object( $Braces->finish->parent, $Braces, "Finish brace sees the PPI::Structure as its parent" ); # Test the ->top method is_object( $Document->top, $Document, "Document sees itself as top" ); is_object( $Statement->top, $Document, "Statement sees document as top" ); is_object( $Token1->top, $Document, "Token sees document as top" ); is_object( $Token2->top, $Document, "Token sees document as top" ); is_object( $Token3->top, $Document, "Token sees document as top" ); is_object( $Braces->top, $Document, "Braces sees document as top" ); is_object( $Token7->top, $Document, "Token sees document as top" ); # Test the ->document method is_object( $Document->document, $Document, "Document sees itself as document" ); is_object( $Statement->document, $Document, "Statement sees document correctly" ); is_object( $Token1->document, $Document, "Token sees document correctly" ); is_object( $Token2->document, $Document, "Token sees document correctly" ); is_object( $Token3->document, $Document, "Token sees document correctly" ); is_object( $Braces->document, $Document, "Braces sees document correctly" ); is_object( $Token7->document, $Document, "Token sees document correctly" ); # Test the ->next_sibling method is( $Document->next_sibling, '', "Document returns false for next_sibling" ); is( $Statement->next_sibling, '', "Statement returns false for next_sibling" ); is_object( $Token1->next_sibling, $Token2, "First token sees second token as next_sibling" ); is_object( $Token2->next_sibling, $Token3, "Second token sees third token as next_sibling" ); is_object( $Braces->next_sibling, $Token7, "Braces sees seventh token as next_sibling" ); is( $Token7->next_sibling, '', 'Last token returns false for next_sibling' ); # More extensive test for next_sibling SCOPE: { my $doc = safe_new \"sub foo { bar(); }"; my $end = $doc->last_token; isa_ok( $end, 'PPI::Token::Structure' ); is( $end->content, '}', 'Got end token' ); is( $end->next_sibling, '', '->next_sibling for an end closing brace returns false' ); my $braces = $doc->find_first( sub { $_[1]->isa('PPI::Structure') and $_[1]->braces eq '()' } ); isa_ok( $braces, 'PPI::Structure' ); isa_ok( $braces->next_token, 'PPI::Token::Structure' ); is( $braces->next_token->content, ';', 'Got the correct next_token for structure' ); } # Test the ->previous_sibling method is( $Document->previous_sibling, '', "Document returns false for previous_sibling" ); is( $Statement->previous_sibling, '', "Statement returns false for previous_sibling" ); is( $Token1->previous_sibling, '', "First token returns false for previous_sibling" ); is_object( $Token2->previous_sibling, $Token1, "Second token sees first token as previous_sibling" ); is_object( $Token3->previous_sibling, $Token2, "Third token sees second token as previous_sibling" ); is_object( $Token7->previous_sibling, $Braces, "Last token sees braces as previous_sibling" ); # More extensive test for next_sibling SCOPE: { my $doc = safe_new \"{ no strict; bar(); }"; my $start = $doc->first_token; isa_ok( $start, 'PPI::Token::Structure' ); is( $start->content, '{', 'Got start token' ); is( $start->previous_sibling, '', '->previous_sibling for a start opening brace returns false' ); my $braces = $doc->find_first( sub { $_[1]->isa('PPI::Structure') and $_[1]->braces eq '()' } ); isa_ok( $braces, 'PPI::Structure' ); isa_ok( $braces->previous_token, 'PPI::Token::Word' ); is( $braces->previous_token->content, 'bar', 'Got the correct previous_token for structure' ); } # Test the ->snext_sibling method my $Token4 = $Statement->{children}->[3]; is( $Document->snext_sibling, '', "Document returns false for snext_sibling" ); is( $Statement->snext_sibling, '', "Statement returns false for snext_sibling" ); is_object( $Token1->snext_sibling, $Token2, "First token sees second token as snext_sibling" ); is_object( $Token2->snext_sibling, $Token4, "Second token sees third token as snext_sibling" ); is_object( $Braces->snext_sibling, $Token7, "Braces sees seventh token as snext_sibling" ); is( $Token7->snext_sibling, '', 'Last token returns false for snext_sibling' ); # Test the ->sprevious_sibling method is( $Document->sprevious_sibling, '', "Document returns false for sprevious_sibling" ); is( $Statement->sprevious_sibling, '', "Statement returns false for sprevious_sibling" ); is( $Token1->sprevious_sibling, '', "First token returns false for sprevious_sibling" ); is_object( $Token2->sprevious_sibling, $Token1, "Second token sees first token as sprevious_sibling" ); is_object( $Token3->sprevious_sibling, $Token2, "Third token sees second token as sprevious_sibling" ); is_object( $Token7->sprevious_sibling, $Braces, "Last token sees braces as sprevious_sibling" ); # Test snext_sibling and sprevious_sibling cases when inside a parent block SCOPE: { my $cpan13454 = safe_new \'{ 1 }'; my $num = $cpan13454->find_first('Token::Number'); isa_ok( $num, 'PPI::Token::Number' ); my $prev = $num->sprevious_sibling; is( $prev, '', '->sprevious_sibling returns false' ); my $next = $num->snext_sibling; is( $next, '', '->snext_sibling returns false' ); } ##################################################################### # Test the PPI::Element and PPI::Node analysis methods # Test the find method SCOPE: { is( $Document->find('PPI::Token::End'), '', '->find returns false if nothing found' ); isa_ok( $Document->find('PPI::Structure')->[0], 'PPI::Structure' ); my $found = $Document->find('PPI::Token::Number'); ok( $found, 'Multiple find succeeded' ); is( ref $found, 'ARRAY', '->find returned an array' ); is( scalar(@$found), 2, 'Multiple find returned expected number of items' ); # Test for the ability to shorten the names $found = $Document->find('Token::Number'); ok( $found, 'Multiple find succeeded' ); is( ref $found, 'ARRAY', '->find returned an array' ); is( scalar(@$found), 2, 'Multiple find returned expected number of items' ); } # Test for CPAN #7799 - Unsupported element types are accepted by find # # The correct behaviour for a bad string is a warning, and return C SCOPE: { local $^W = 0; is( $Document->find(undef), undef, '->find(undef) failed' ); is( $Document->find([]), undef, '->find([]) failed' ); is( $Document->find('Foo'), undef, '->find(BAD) failed' ); } # Test the find_first method SCOPE: { is( $Document->find_first('PPI::Token::End'), '', '->find_first returns false if nothing found' ); isa_ok( $Document->find_first('PPI::Structure'), 'PPI::Structure' ); my $found = $Document->find_first('PPI::Token::Number'); ok( $found, 'Multiple find_first succeeded' ); isa_ok( $found, 'PPI::Token::Number' ); # Test for the ability to shorten the names $found = $Document->find_first('Token::Number'); ok( $found, 'Multiple find_first succeeded' ); isa_ok( $found, 'PPI::Token::Number' ); } # Test the find_any method SCOPE: { is( $Document->find_any('PPI::Token::End'), '', '->find_any returns false if nothing found' ); is( $Document->find_any('PPI::Structure'), 1, '->find_any returns true is something found' ); is( $Document->find_any('PPI::Token::Number'), 1, '->find_any returns true for multiple find' ); is( $Document->find_any('Token::Number'), 1, '->find_any returns true for shortened multiple find' ); } # Test the contains method SCOPE: { omethod_fails( $Document, 'contains', [ undef, '', 1, [], bless( {}, 'Foo') ] ); my $found = $Document->find('PPI::Element'); is( ref $found, 'ARRAY', '(preparing for contains tests) ->find returned an array' ); is( scalar(@$found), 15, '(preparing for contains tests) ->find returns correctly for all elements' ); foreach my $Element ( @$found ) { is( $Document->contains( $Element ), 1, 'Document contains ' . ref($Element) . ' known to be in it' ); } shift @$found; foreach my $Element ( @$found ) { is( $Document->contains( $Element ), 1, 'Statement contains ' . ref($Element) . ' known to be in it' ); } } ##################################################################### # Test the PPI::Element manipulation methods # Cloning an Element/Node SCOPE: { my $Doc2 = $Document->clone; isa_ok( $Doc2->schild(0), 'PPI::Statement' ); is_object( $Doc2->schild(0)->parent, $Doc2, 'Basic parent links stay intact after ->clone' ); is_object( $Doc2->schild(0)->schild(3)->start->document, $Doc2, 'Clone goes deep, and Structure braces get relinked properly' ); isnt( refaddr($Document), refaddr($Doc2), 'Cloned Document has a different memory location' ); isnt( refaddr($Document->schild(0)), refaddr($Doc2->schild(0)), 'Cloned Document has children at different memory locations' ); } # Delete the second token ok( $Token2->delete, "Deletion of token 2 returns true" ); is( $Document->content, 'my = (1, 2);', "Content is modified correctly" ); is( scalar($Document->tokens), 11, "Modified source contains the correct number of tokens" ); ok( ! defined $Token2->parent, "Token 2 is detached from parent" ); # Delete the braces ok( $Braces->delete, "Deletion of braces returns true" ); is( $Document->content, 'my = ;', "Content is modified correctly" ); is( scalar($Document->tokens), 5, "Modified source contains the correct number of tokens" ); ok( ! defined $Braces->parent, "Braces are detached from parent" ); ##################################################################### # Test DESTROY # Start with DESTROY for an element that never has a parent SCOPE: { my $Token = PPI::Token::Whitespace->new( ' ' ); my $k1 = scalar keys %_PARENT; $Token->DESTROY; my $k2 = scalar keys %_PARENT; is( $k1, $k2, '_PARENT key count remains unchanged after naked Element DESTROY' ); } # Next, a single element within a parent SCOPE: { my $k1 = scalar keys %_PARENT; my $k2; my $k3; SCOPE: { my $Token = PPI::Token::Number->new( '1' ); my $Statement = PPI::Statement->new; $Statement->add_element( $Token ); $k2 = scalar keys %_PARENT; is( $k2, $k1 + 1, 'PARENT keys increases after adding element' ); $Statement->DESTROY; } pause(); $k3 = scalar keys %_PARENT; is( $k3, $k1, 'PARENT keys returns to original on DESTROY' ); } # Repeat for an entire (large) file SCOPE: { my $k1 = scalar keys %_PARENT; my $k2; my $k3; SCOPE: { my $NodeDocument = safe_new $INC{"PPI/Node.pm"}; $k2 = scalar keys %_PARENT; ok( $k2 > ($k1 + 3000), 'PARENT keys increases after loading document' ); $NodeDocument->DESTROY; } pause(); $k3 = scalar keys %_PARENT; is( $k3, $k1, 'PARENT keys returns to original on explicit Document DESTROY' ); } # Repeat again, but with an implicit DESTROY SCOPE: { my $k1 = scalar keys %_PARENT; my $k2; my $k3; SCOPE: { my $NodeDocument = safe_new $INC{"PPI/Node.pm"}; $k2 = scalar keys %_PARENT; ok( $k2 > ($k1 + 3000), 'PARENT keys increases after loading document' ); } pause(); $k3 = scalar keys %_PARENT; is( $k3, $k1, 'PARENT keys returns to original on implicit Document DESTROY' ); } ##################################################################### # Token-related methods # Test first_token, last_token, next_token and previous_token SCOPE: { my $code = <<'END_PERL'; my $foo = bar(); sub foo { my ($foo, $bar, undef) = ('a', shift(@_), 'bar'); return [ $foo, $bar ]; } END_PERL # Trim off the trailing newline to test last_token better $code =~ s/\s+$//s; # Create the document my $doc = safe_new \$code; # Basic first_token and last_token using a single non-trival sample ### FIXME - Make this more thorough my $first_token = $doc->first_token; isa_ok( $first_token, 'PPI::Token::Word' ); is( $first_token->content, 'my', '->first_token works as expected' ); my $last_token = $doc->last_token; isa_ok( $last_token, 'PPI::Token::Structure' ); is( $last_token->content, '}', '->last_token works as expected' ); # Test next_token is( $last_token->next_token, '', 'last->next_token returns false' ); is( $doc->next_token, '', 'doc->next_token returns false' ); my $next_token = $first_token->next_token; isa_ok( $next_token, 'PPI::Token::Whitespace' ); is( $next_token->content, ' ', 'Trivial ->next_token works as expected' ); my $counter = 1; my $token = $first_token; while ( $token = $token->next_token ) { $counter++; } is( $counter, scalar($doc->tokens), '->next_token iterated the expected number of times for a sample document' ); # Test previous_token is( $first_token->previous_token, '', 'last->previous_token returns false' ); is( $doc->previous_token, '', 'doc->previous_token returns false' ); my $previous_token = $last_token->previous_token; isa_ok( $previous_token, 'PPI::Token::Whitespace' ); is( $previous_token->content, "\n", 'Trivial ->previous_token works as expected' ); $counter = 1; $token = $last_token; while ( $token = $token->previous_token ) { $counter++; } is( $counter, scalar($doc->tokens), '->previous_token iterated the expected number of times for a sample document' ); } ##################################################################### # Simple overload tests # Make sure the 'use overload' is working on Element subclasses SCOPE: { my $source = '1;'; my $Document = PPI::Lexer->lex_source( $source ); isa_ok( $Document, 'PPI::Document' ); ok($Document eq $source, 'overload eq'); ok($Document ne 'foo', 'overload ne'); ok($Document == $Document, 'overload =='); ok($Document != $Document->schild(0), 'overload !='); } PPI-1.278/t/ppi_statement_scheduled.t0000644000175000017500000000226214573465137016154 0ustar olafolaf#!/usr/bin/perl # Test PPI::Statement::Scheduled use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 280 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; SUB_WORD_OPTIONAL: { for my $name ( qw( BEGIN CHECK UNITCHECK INIT END ) ) { for my $sub ( '', 'sub ' ) { # '{}' -- function definition # ';' -- function declaration # '' -- function declaration with missing semicolon for my $followed_by ( ' {}', '{}', ';', '' ) { test_sub_as( $sub, $name, $followed_by ); } } } } sub test_sub_as { my ( $sub, $name, $followed_by ) = @_; my $code = "$sub$name$followed_by"; my $Document = safe_new \$code; my ( $sub_statement, $dummy ) = $Document->schildren; isa_ok( $sub_statement, 'PPI::Statement::Scheduled', "$code: document child is a scheduled statement" ); is( $dummy, undef, "$code: document has exactly one child" ); ok( $sub_statement->reserved, "$code: is reserved" ); is( $sub_statement->name, $name, "$code: name() correct" ); if ( $followed_by =~ /}/ ) { isa_ok( $sub_statement->block, 'PPI::Structure::Block', "$code: has a block" ); } else { ok( !$sub_statement->block, "$code: has no block" ); } return; } PPI-1.278/t/ppi_token_quotelike_words.t0000644000175000017500000001557214573465137016560 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::QuoteLike::Words use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 2425 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; sub permute_test; sub assemble_and_run; my %known_bad = map { $_ => 1 } "qw ' \\' '", "qw ( \\( )", "qw ( \\) )", "qw / \\/ /", "qw 1 a \\1 1", "qw < \\< >", "qw < \\> >", "qw [ \\[ ]", "qw [ \\] ]", "qw \" \\\" \"", "qw a \\a a", "qw { \\{ }", "qw { \\} }", "qw# \\# #", "qw#\\##", "qw#\n\\#\n#", "qw' \\' '", "qw'\\''", "qw'\f\\'\f'", "qw'\n\\'\n'", "qw'\t\\'\t'", "qw( \\( )", "qw( \\) )", "qw( \\\\ )", "qw(\\()", "qw(\\))", "qw(\f\\(\f)", "qw(\f\\)\f)", "qw(\n\\(\n)", "qw(\n\\)\n)", "qw(\n\\\\\n)", "qw(\t\\(\t)", "qw(\t\\)\t)", "qw/ \\/ /", "qw/\\//", "qw/\f\\/\f/", "qw/\n\\/\n/", "qw/\t\\/\t/", "qw< \\< >", "qw< \\> >", "qw<\\<>", "qw<\\>>", "qw<\f\\<\f>", "qw<\f\\>\f>", "qw<\n\\<\n>", "qw<\n\\>\n>", "qw<\t\\<\t>", "qw<\t\\>\t>", "qw[ \\[ ]", "qw[ \\] ]", "qw[\\[]", "qw[\\]]", "qw[\f\\[\f]", "qw[\f\\]\f]", "qw[\n\\[\n]", "qw[\n\\]\n]", "qw[\t\\[\t]", "qw[\t\\]\t]", "qw\" \\\" \"", "qw\"\\\"\"", "qw\"\f\\\"\f\"", "qw\"\n\\\"\n\"", "qw\"\t\\\"\t\"", "qw\f'\f\\'\f'", "qw\f(\f\\(\f)", "qw\f(\f\\)\f)", "qw\f/\f\\/\f/", "qw\f<\f\\<\f>", "qw\f<\f\\>\f>", "qw\f[\f\\[\f]", "qw\f[\f\\]\f]", "qw\f\"\f\\\"\f\"", "qw\f{\f\\{\f}", "qw\f{\f\\}\f}", "qw\n'\n\\'\n'", "qw\n(\n\\(\n)", "qw\n(\n\\)\n)", "qw\n/\n\\/\n/", "qw\n<\n\\<\n>", "qw\n<\n\\>\n>", "qw\n[\n\\[\n]", "qw\n[\n\\]\n]", "qw\n\"\n\\\"\n\"", "qw\na\n\\a\na", "qw\n{\n\\{\n}", "qw\n{\n\\}\n}", "qw\t'\t\\'\t'", "qw\t(\t\\(\t)", "qw\t(\t\\)\t)", "qw\t/\t\\/\t/", "qw\t<\t\\<\t>", "qw\t<\t\\>\t>", "qw\t[\t\\[\t]", "qw\t[\t\\]\t]", "qw\t\"\t\\\"\t\"", "qw\t{\t\\{\t}", "qw\t{\t\\}\t}", "qw{ \\{ }", "qw{ \\} }", "qw{\\{}", "qw{\\}}", "qw{\f\\{\f}", "qw{\f\\}\f}", "qw{\n\\{\n}", "qw{\n\\}\n}", "qw{\t\\{\t}", "qw{\t\\}\t}"; LITERAL: { # empty permute_test [], '/', '/', []; permute_test [], '"', '"', []; permute_test [], "'", "'", []; permute_test [], '(', ')', []; permute_test [], '{', '}', []; permute_test [], '[', ']', []; permute_test [], '<', '>', []; # words permute_test ['a', 'b', 'c'], '/', '/', ['a', 'b', 'c']; permute_test ['a,', 'b', 'c,'], '/', '/', ['a,', 'b', 'c,']; permute_test ['a', ',', '#', 'c'], '/', '/', ['a', ',', '#', 'c']; permute_test ['f_oo', 'b_ar'], '/', '/', ['f_oo', 'b_ar']; # it's allowed for both delims to be closers permute_test ['a'], ')', ')', ['a']; permute_test ['a'], '}', '}', ['a']; permute_test ['a'], ']', ']', ['a']; permute_test ['a'], '>', '>', ['a']; # containing things that sometimes are delimiters permute_test ['/'], '(', ')', ['/']; permute_test ['//'], '(', ')', ['//']; permute_test ['qw()'], '(', ')', ['qw()']; permute_test ['qw', '()'], '(', ')', ['qw', '()']; permute_test ['qw//'], '(', ')', ['qw//']; # nested delimiters permute_test ['()'], '(', ')', ['()']; permute_test ['{}'], '{', '}', ['{}']; permute_test ['[]'], '[', ']', ['[]']; permute_test ['<>'], '<', '>', ['<>']; permute_test ['((', ')', ')'], '(', ')', ['((', ')', ')']; permute_test ['{{', '}', '}'], '{', '}', ['{{', '}', '}']; permute_test ['[[', ']', ']'], '[', ']', ['[[', ']', ']']; permute_test ['<<', '>', '>'], '<', '>', ['<<', '>', '>']; my $bs = '\\'; # a single backslash character # escaped opening and closing permute_test ["$bs)"], '(', ')', [')']; permute_test ["$bs("], '(', ')', ['(']; permute_test ["$bs}"], '{', '}', ['}']; permute_test [$bs.'{'], '{', '}', ['{']; permute_test ["$bs]"], '[', ']', [']']; permute_test [$bs.'['], '[', ']', ['[']; permute_test ["$bs<"], '<', '>', ['<']; permute_test ["$bs>"], '<', '>', ['>']; permute_test ["$bs/"], '/', '/', ['/']; permute_test ["$bs'"], "'", "'", ["'"]; permute_test [$bs.'"'], '"', '"', ['"']; # alphanum delims have to be separated from qw assemble_and_run " ", ['a', "${bs}1"], '1', " ", " ", '1', ['a', '1']; assemble_and_run " ", ["${bs}a"], 'a', " ", " ", 'a', ['a']; assemble_and_run "\n", ["${bs}a"], 'a', "\n", "\n", 'a', ['a']; # '#' delims cannot be separated from qw assemble_and_run '', ['a'], '#', '', ' ', '#', ['a']; assemble_and_run '', ['a'], '#', ' ', ' ', '#', ['a']; assemble_and_run '', ["$bs#"], '#', '', ' ', '#', ['#']; assemble_and_run '', ["$bs#"], '#', ' ', ' ', '#', ['#']; assemble_and_run '', ["$bs#"], '#', "\n", "\n", '#', ['#']; # a single backslash represents itself assemble_and_run '', [$bs], '(', ' ', ' ', ')', [$bs]; assemble_and_run '', [$bs], '(', "\n", ' ', ')', [$bs]; # a double backslash represents itself assemble_and_run '', ["$bs$bs"], '(', ' ', ' ', ')', [$bs]; assemble_and_run '', ["$bs$bs"], '(', "\n", ' ', ')', [$bs]; # even backslash can be a delimiter, in when it is, backslashes # can't be embedded or escaped. assemble_and_run '', [], $bs, ' ', ' ', $bs, []; assemble_and_run '', [], $bs, "\n", "\n", $bs, []; assemble_and_run '', ['a'], $bs, '', ' ', $bs, ['a']; assemble_and_run ' ', ['a'], $bs, '', ' ', $bs, ['a']; assemble_and_run "\n", ['a'], $bs, '', ' ', $bs, ['a']; } sub execute_test { my ( $code, $expected, $msg ) = @_; my $d = safe_new \$code; my $found = $d->find( 'PPI::Token::QuoteLike::Words' ) || []; is( @$found, 1, "$msg - exactly one qw" ); is( $found->[0]->content, $code, "$msg content()" ); is_deeply( [ $found->[0]->literal ], $expected, "literal()" ); # can't dump $msg, as it breaks TODO parsing return; } sub assemble_and_run { my ( $pre_left_delim, $words_in, $left_delim, $delim_padding, $word_separator, $right_delim, $expected ) = @_; my $code = "qw$pre_left_delim$left_delim$delim_padding" . join(' ', @$words_in) . "$delim_padding$right_delim"; execute_test $code, $expected, $code; return; } sub permute_test { my ( $words_in, $left_delim, $right_delim, $expected ) = @_; assemble_and_run "", $words_in, $left_delim, "", " ", $right_delim, $expected; assemble_and_run "", $words_in, $left_delim, "", "\t", $right_delim, $expected; assemble_and_run "", $words_in, $left_delim, "", "\n", $right_delim, $expected; assemble_and_run "", $words_in, $left_delim, "", "\f", $right_delim, $expected; assemble_and_run "", $words_in, $left_delim, " ", " ", $right_delim, $expected; assemble_and_run "", $words_in, $left_delim, "\t", "\t", $right_delim, $expected; assemble_and_run "", $words_in, $left_delim, "\n", "\n", $right_delim, $expected; assemble_and_run "", $words_in, $left_delim, "\f", "\f", $right_delim, $expected; assemble_and_run " ", $words_in, $left_delim, " ", " ", $right_delim, $expected; assemble_and_run "\t", $words_in, $left_delim, "\t", "\t", $right_delim, $expected; assemble_and_run "\n", $words_in, $left_delim, "\n", "\n", $right_delim, $expected; assemble_and_run "\f", $words_in, $left_delim, "\f", "\f", $right_delim, $expected; return; } PPI-1.278/t/25_increment.t0000644000175000017500000000107114573465137013547 0ustar olafolaf#!/usr/bin/perl # Given that we know the regression tests represent potentially # broken locations in the code, process every single transitional # state between an empty document and the entire file to make sure # all of them parse as legal documents and don't crash the parser. use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 9554 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI::Test::Run (); ##################################################################### # Code/Dump Testing PPI::Test::Run->increment_testdir(qw{ t data 08_regression }); PPI-1.278/t/ppi_token_dashedword.t0000644000175000017500000000125014573465137015450 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::DashedWord use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 12 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; LITERAL: { my @pairs = ( "-foo", '-foo', "-Foo::Bar", '-Foo::Bar', "-Foo'Bar", '-Foo::Bar', ); while ( @pairs ) { my $from = shift @pairs; my $to = shift @pairs; my $doc = safe_new \"( $from => 1 );"; my $word = $doc->find_first('Token::DashedWord'); SKIP: { skip( "PPI::Token::DashedWord is deactivated", 2 ); isa_ok( $word, 'PPI::Token::DashedWord' ); is( $word && $word->literal, $to, "The source $from becomes $to ok" ); } } } PPI-1.278/t/26_bom.t0000644000175000017500000000044114573465137012341 0ustar olafolaf#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 20 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI::Test::Run (); ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir(qw{ t data 26_bom }); PPI-1.278/t/ppi_token_quote_interpolate.t0000644000175000017500000000146714573465137017101 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Quote::Interpolate use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 9 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; STRING: { my $Document = safe_new \"print qq{foo}, qq!bar!, qq ;"; my $Interpolate = $Document->find('Token::Quote::Interpolate'); is( scalar(@$Interpolate), 3, '->find returns three objects' ); isa_ok( $Interpolate->[0], 'PPI::Token::Quote::Interpolate' ); isa_ok( $Interpolate->[1], 'PPI::Token::Quote::Interpolate' ); isa_ok( $Interpolate->[2], 'PPI::Token::Quote::Interpolate' ); is( $Interpolate->[0]->string, 'foo', '->string returns as expected' ); is( $Interpolate->[1]->string, 'bar', '->string returns as expected' ); is( $Interpolate->[2]->string, 'foo', '->string returns as expected' ); } PPI-1.278/t/15_transform.t0000644000175000017500000000703614573465137013604 0ustar olafolaf#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use File::Copy qw( copy ); use File::Spec::Functions qw( catdir catfile ); use File::Temp qw( tempdir ); use PPI (); use PPI::Transform (); use Scalar::Util qw( refaddr ); use Test::More 0.86 tests => 26 + ($ENV{AUTHOR_TESTING} ? 1 : 0); ##################################################################### # Begin Tests APPLY: { my $code = 'my $foo = "bar";'; my $rv = MyCleaner->apply( \$code ); ok( $rv, 'MyCleaner->apply( \$code ) returns true' ); is( $code, 'my$foo="bar";', 'MyCleaner->apply( \$code ) modifies code as expected' ); ok( PPI::Transform->register_apply_handler( 'Foo', \&Foo::get, \&Foo::set ), "register_apply_handler worked", ); $Foo::VALUE = 'my $foo = "bar";'; my $Foo = Foo->new; isa_ok( $Foo, 'Foo' ); ok( MyCleaner->apply( $Foo ), 'MyCleaner->apply( $Foo ) returns true' ); is( $Foo::VALUE, 'my$foo="bar";', 'MyCleaner->apply( $Foo ) modifies code as expected' ); } ##################################################################### # File transforms my $testdir = catdir( 't', 'data', '15_transform'); # Does the test directory exist? ok( (-e $testdir and -d $testdir and -r $testdir), "Test directory $testdir found" ); # Find the .pm test files opendir( TESTDIR, $testdir ) or die "opendir: $!"; my @files = sort grep { /\.pm$/ } readdir(TESTDIR); closedir( TESTDIR ) or die "closedir: $!"; ok( scalar @files, 'Found at least one .pm file' ); ##################################################################### # Testing my $tempdir = tempdir(CLEANUP => 1); foreach my $input ( @files ) { # Prepare my $copy = catfile($tempdir, "${input}_copy"); my $copy2 = catfile($tempdir, "${input}_copy2"); $input = catfile($testdir, $input); my $output = "${input}_out"; ok( copy( $input, $copy ), "Copied $input to $copy" ); my $Original = new_ok( 'PPI::Document' => [ $input ] ); my $Input = new_ok( 'PPI::Document' => [ $input ] ); my $Output = new_ok( 'PPI::Document' => [ $output ] ); # Process the file my $rv = MyCleaner->document( $Input ); isa_ok( $rv, 'PPI::Document' ); is( refaddr($rv), refaddr($Input), '->document returns original document' ); is_deeply( $Input, $Output, 'Transform works as expected' ); # Squish to another location ok( MyCleaner->file( $copy, $copy2 ), '->file returned true' ); my $Copy = new_ok( 'PPI::Document' => [ $copy ] ); is_deeply( $Copy, $Original, 'targeted transform leaves original unchanged' ); my $Copy2 = new_ok( 'PPI::Document' => [ $copy2 ] ); is_deeply( $Copy2, $Output, 'targeted transform works as expected' ); # Copy the file and process in-place ok( MyCleaner->file( $copy ), '->file returned true' ); $Copy = new_ok( 'PPI::Document' => [ $copy ] ); is_deeply( $Copy, $Output, 'In-place transform works as expected' ); } eval { PPI::Transform->document }; like $@, qr/PPI::Transform does not implement the required ->document method/, "transform classes need to implement ->document"; ##################################################################### # Support Code # Test Transform class package MyCleaner; use Params::Util qw( _INSTANCE ); use PPI::Transform (); our @ISA; BEGIN { @ISA = 'PPI::Transform'; # in a BEGIN block due to being an inline package } sub document { my $self = shift; my $Document = _INSTANCE(shift, 'PPI::Document') or return undef; $Document->prune( 'Token::Whitespace' ); $Document; } package Foo; use Helper 'safe_new'; sub new { bless { }, 'Foo'; } our $VALUE = ''; sub get { safe_new \$VALUE; } sub set { $VALUE = $_[1]->serialize; } PPI-1.278/t/marpa.t0000644000175000017500000002306114573465137012360 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Unknown use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 69 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); use B qw( perlstring ); use PPI (); use Helper 'safe_new'; test_statement( 'use v5 ;', [ 'PPI::Statement::Include' => 'use v5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 ;', [ 'PPI::Statement::Include' => 'use 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 ;', [ 'PPI::Statement::Include' => 'use 5.1 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz () ;', [ 'PPI::Statement::Include' => 'use xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use v5 xyz () ;', [ 'PPI::Statement::Include' => 'use v5 xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 xyz () ;', [ 'PPI::Statement::Include' => 'use 5 xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 xyz () ;', [ 'PPI::Statement::Include' => 'use 5.1 xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz v5 () ;', [ 'PPI::Statement::Include' => 'use xyz v5 () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Version' => 'v5', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5 () ;', [ 'PPI::Statement::Include' => 'use xyz 5 () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 () ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use v5 xyz 5 ;', [ 'PPI::Statement::Include' => 'use v5 xyz 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 xyz 5 ;', [ 'PPI::Statement::Include' => 'use 5 xyz 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 xyz 5 ;', [ 'PPI::Statement::Include' => 'use 5.1 xyz 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz v5 5 ;', [ 'PPI::Statement::Include' => 'use xyz v5 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5 5 ;', [ 'PPI::Statement::Include' => 'use xyz 5 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 5 ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use v5 xyz 5,5 ;', [ 'PPI::Statement::Include' => 'use v5 xyz 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 xyz 5,5 ;', [ 'PPI::Statement::Include' => 'use 5 xyz 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 xyz 5,5 ;', [ 'PPI::Statement::Include' => 'use 5.1 xyz 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz v5 5,5 ;', [ 'PPI::Statement::Include' => 'use xyz v5 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5 5,5 ;', [ 'PPI::Statement::Include' => 'use xyz 5 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 5,5 ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 @a ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 @a ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Symbol' => '@a', 'PPI::Token::Structure' => ';' ] ); sub one_line_explain { my ( $data ) = @_; my @explain = explain $data; s/\n//g for @explain; return join "", @explain; } sub main_level_line { return "" if not $TODO; my @outer_final; my $level = 0; while ( my @outer = caller( $level++ ) ) { @outer_final = @outer; } return "l $outer_final[2] - "; } sub test_statement { local $Test::Builder::Level = $Test::Builder::Level + 1; my ( $code, $expected, $msg ) = @_; $msg = perlstring $code if !defined $msg; my $d = safe_new \$code; my $tokens = $d->find( sub { $_[1]->significant } ); $tokens = [ map { ref( $_ ), $_->content } @$tokens ]; if ( $expected->[0] !~ /^PPI::Statement/ ) { $expected = [ 'PPI::Statement', $code, @$expected ]; } my $ok = is_deeply( $tokens, $expected, main_level_line . $msg ); if ( !$ok ) { diag ">>> $code -- $msg\n"; diag "GOT: " . one_line_explain $tokens; diag "EXP: " . one_line_explain $expected; } return; } PPI-1.278/t/ppi_element.t0000644000175000017500000001265214573465137013565 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Element use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 68 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; __INSERT_AFTER: { my $Document = safe_new \"print 'Hello World';"; my $string = $Document->find_first('Token::Quote'); isa_ok( $string, 'PPI::Token::Quote' ); is( $string->content, "'Hello World'", 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $string->__insert_after( $foo ); is( $Document->serialize, "print 'Hello World'foo;", '__insert_after actually inserts' ); } __INSERT_BEFORE: { my $Document = safe_new \"print 'Hello World';"; my $semi = $Document->find_first('Token::Structure'); isa_ok( $semi, 'PPI::Token::Structure' ); is( $semi->content, ';', 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $semi->__insert_before( $foo ); is( $Document->serialize, "print 'Hello World'foo;", '__insert_before actually inserts' ); } ANCESTOR_OF: { my $Document = safe_new \'( [ thingy ] ); $blarg = 1'; ok( $Document->ancestor_of($Document), 'Document is an ancestor of itself.', ); my $words = $Document->find('Token::Word'); is(scalar @{$words}, 1, 'Document contains 1 Word.'); my $word = $words->[0]; ok( $word->ancestor_of($word), 'Word is an ancestor of itself.', ); ok( ! $word->ancestor_of($Document), 'Word is not an ancestor of the Document.', ); ok( $Document->ancestor_of($word), 'Document is an ancestor of the Word.', ); my $symbols = $Document->find('Token::Symbol'); is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.'); my $symbol = $symbols->[0]; ok( ! $word->ancestor_of($symbol), 'Word is not an ancestor the Symbol.', ); ok( ! $symbol->ancestor_of($word), 'Symbol is not an ancestor the Word.', ); } COLUMN_NUMBER: { my $document = safe_new \<<'END_PERL'; foo END_PERL my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->column_number, 4, 'Got correct column number.' ); } DESCENDANT_OF: { my $Document = safe_new \'( [ thingy ] ); $blarg = 1'; ok( $Document->descendant_of($Document), 'Document is a descendant of itself.', ); my $words = $Document->find('Token::Word'); is(scalar @{$words}, 1, 'Document contains 1 Word.'); my $word = $words->[0]; ok( $word->descendant_of($word), 'Word is a descendant of itself.', ); ok( $word->descendant_of($Document), 'Word is a descendant of the Document.', ); ok( ! $Document->descendant_of($word), 'Document is not a descendant of the Word.', ); my $symbols = $Document->find('Token::Symbol'); is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.'); my $symbol = $symbols->[0]; ok( ! $word->descendant_of($symbol), 'Word is not a descendant the Symbol.', ); ok( ! $symbol->descendant_of($word), 'Symbol is not a descendant the Word.', ); } INSERT_AFTER: { my $Document = safe_new \"print 'Hello World';"; my $string = $Document->find_first('Token::Quote'); isa_ok( $string, 'PPI::Token::Quote' ); is( $string->content, "'Hello World'", 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $string->insert_after( $foo ); is( $Document->serialize, "print 'Hello World'foo;", 'insert_after actually inserts' ); } INSERT_BEFORE: { my $Document = safe_new \"print 'Hello World';"; my $semi = $Document->find_first('Token::Structure'); isa_ok( $semi, 'PPI::Token::Structure' ); is( $semi->content, ';', 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $semi->insert_before( $foo ); is( $Document->serialize, "print 'Hello World'foo;", 'insert_before actually inserts' ); } LINE_NUMBER: { my $document = safe_new \<<'END_PERL'; foo END_PERL my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->line_number, 3, 'Got correct line number.' ); } LOGICAL_FILENAME: { # Double quoted so that we don't really have a "#line" at the beginning and # errors in this file itself aren't affected by this. my $document = safe_new \<<"END_PERL"; \#line 1 test-file foo END_PERL my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->logical_filename, 'test-file', 'Got correct logical line number.', ); } LOGICAL_LINE_NUMBER: { # Double quoted so that we don't really have a "#line" at the beginning and # errors in this file itself aren't affected by this. my $document = safe_new \<<"END_PERL"; \#line 1 test-file foo END_PERL my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->logical_line_number, 1, 'Got correct logical line number.' ); } VISUAL_COLUMN_NUMBER: { my $document = safe_new \<<"END_PERL"; \t foo END_PERL my $tab_width = 5; $document->tab_width($tab_width); # don't use a "usual" value. my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->visual_column_number, $tab_width + 2, 'Got correct visual column number.', ); } PPI-1.278/t/ppi_statement_variable.t0000644000175000017500000000250014573465137015774 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Statement::Variable use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 18 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; VARIABLES: { # Test the things we assert to work in the synopsis my $Document = safe_new \<<'END_PERL'; package Bar; my $foo = 1; my ( $foo, $bar) = (1, 2); our $foo = 1; local $foo; local $foo = 1; LABEL: my $foo = 1; # As well as those basics, lets also try some harder ones local($foo = $bar->$bar(), $bar); END_PERL # There should be 6 statement objects my $ST = $Document->find('Statement::Variable'); is( ref($ST), 'ARRAY', 'Found statements' ); is( scalar(@$ST), 7, 'Found 7 ::Variable objects' ); foreach my $Var ( @$ST ) { isa_ok( $Var, 'PPI::Statement::Variable' ); } is_deeply( [ $ST->[0]->variables ], [ '$foo' ], '1: Found $foo' ); is_deeply( [ $ST->[1]->variables ], [ '$foo', '$bar' ], '2: Found $foo and $bar' ); is_deeply( [ $ST->[2]->variables ], [ '$foo' ], '3: Found $foo' ); is_deeply( [ $ST->[3]->variables ], [ '$foo' ], '4: Found $foo' ); is_deeply( [ $ST->[4]->variables ], [ '$foo' ], '5: Found $foo' ); is_deeply( [ $ST->[5]->variables ], [ '$foo' ], '6: Found $foo' ); is_deeply( [ $ST->[6]->variables ], [ '$foo', '$bar' ], '7: Found $foo and $bar' ); } PPI-1.278/t/ppi_statement_compound.t0000644000175000017500000000557214573465137016047 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Statement::Compound use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 53 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; TYPE: { my $Document = safe_new \<<'END_PERL'; while (1) { } until (1) { } LABEL: while (1) { } LABEL: until (1) { } if (1) { } unless (1) { } for (@foo) { } foreach (@foo) { } for $x (@foo) { } foreach $x (@foo) { } for my $x (@foo) { } foreach my $x (@foo) { } for state $x (@foo) { } foreach state $x (@foo) { } LABEL: for (@foo) { } LABEL: foreach (@foo) { } LABEL: for $x (@foo) { } LABEL: foreach $x (@foo) { } LABEL: for my $x (@foo) { } LABEL: foreach my $x (@foo) { } LABEL: for state $x (@foo) { } LABEL: foreach state $x (@foo) { } for qw{foo} { } foreach qw{foo} { } for $x qw{foo} { } foreach $x qw{foo} { } for my $x qw{foo} { } foreach my $x qw{foo} { } for state $x qw{foo} { } foreach state $x qw{foo} { } LABEL: for qw{foo} { } LABEL: foreach qw{foo} { } LABEL: for $x qw{foo} { } LABEL: foreach $x qw{foo} { } LABEL: for my $x qw{foo} { } LABEL: foreach my $x qw{foo} { } LABEL: for state $x qw{foo} { } LABEL: foreach state $x qw{foo} { } for ( ; ; ) { } foreach ( ; ; ) { } for ($x = 0 ; $x < 1; $x++) { } foreach ($x = 0 ; $x < 1; $x++) { } for (my $x = 0 ; $x < 1; $x++) { } foreach (my $x = 0 ; $x < 1; $x++) { } LABEL: for ( ; ; ) { } LABEL: foreach ( ; ; ) { } LABEL: for ($x = 0 ; $x < 1; $x++) { } LABEL: foreach ($x = 0 ; $x < 1; $x++) { } LABEL: for (my $x = 0 ; $x < 1; $x++) { } LABEL: foreach (my $x = 0 ; $x < 1; $x++) { } END_PERL my $statements = $Document->find('Statement::Compound'); is( scalar @{$statements}, 50, 'Found the 50 test statements' ); is( $statements->[0]->type, 'while', q ); is( $statements->[1]->type, 'while', q ); is( $statements->[2]->type, 'while', q ); is( $statements->[3]->type, 'while', q ); is( $statements->[4]->type, 'if', q ); is( $statements->[5]->type, 'if', q ); foreach my $index (6..37) { my $statement = $statements->[$index]; is( $statement->type, 'foreach', qq ); } foreach my $index (38..49) { my $statement = $statements->[$index]; is( $statement->type, 'for', qq ); } } PPI-1.278/t/00-report-prereqs.dd0000644000175000017500000000770014573465137014615 0ustar olafolafdo { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' } }, 'develop' => { 'recommends' => { 'Dist::Zilla::PluginBundle::Git::VersionManager' => '0.007' }, 'requires' => { 'Devel::Confess' => '0', 'Encode' => '0', 'File::Spec' => '0', 'IO::All' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'MetaCPAN::Client' => '0', 'Test2::V0' => '0', 'Test::CPAN::Meta' => '0', 'Test::ClassAPI' => '0', 'Test::DependentModules' => '0', 'Test::Kwalitee' => '1.21', 'Test::Mojibake' => '0', 'Test::More' => '0.94', 'Test::Pod' => '1.41', 'Test::Pod::No404s' => '0', 'Test::Portability::Files' => '0', 'lib' => '0', 'perl' => '5.010', 'strictures' => '2', 'warnings' => '0' } }, 'runtime' => { 'requires' => { 'Carp' => '0', 'Clone' => '0.30', 'Digest::MD5' => '2.35', 'Exporter' => '0', 'File::Path' => '0', 'File::Spec' => '0', 'List::Util' => '1.33', 'Params::Util' => '1.00', 'Scalar::Util' => '0', 'Storable' => '2.17', 'Task::Weaken' => '0', 'constant' => '0', 'if' => '0', 'overload' => '0', 'perl' => '5.006', 'strict' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'B' => '0', 'Class::Inspector' => '1.22', 'Encode' => '0', 'ExtUtils::MakeMaker' => '0', 'File::Copy' => '0', 'File::Spec' => '0', 'File::Spec::Functions' => '0', 'File::Temp' => '0', 'Test::More' => '0.96', 'Test::NoWarnings' => '0', 'Test::Object' => '0.07', 'Test::SubCalls' => '1.07', 'lib' => '0', 'parent' => '0', 'utf8' => '0', 'warnings' => '0' } } }; $x; }PPI-1.278/t/17_storable.t0000644000175000017500000000251214573465137013400 0ustar olafolaf#!/usr/bin/perl # Test compatibility with Storable use lib 't/lib'; use PPI::Test::pragmas; use PPI (); use Scalar::Util qw( refaddr ); use Test::More; BEGIN { # Is Storable installed? if ( eval { require Storable; 1 } ) { plan( tests => 9 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); } else { plan( 'skip_all' ); exit(0); } } ##################################################################### # Test freeze/thaw of PPI::Document objects SCOPE: { # Create a document with various example package statements my $Document = PPI::Lexer->lex_source( <<'END_PERL' ); package Foo; @ISA = (qw/File::Spec/); 1; END_PERL Test::More::isa_ok( $Document, 'PPI::Document' ); { my $isa = $Document->find_first(sub { $_[1] eq '@ISA'; }); Test::More::ok( $isa, "Found ISA var"); Test::More::is( $isa->parent, q|@ISA = (qw/File::Spec/);|, "Got parent ok"); } my $clone = Storable::dclone($Document); Test::More::ok($clone, "dclone ok"); Test::More::isnt( refaddr($Document), refaddr($clone), "Not the same object" ); Test::More::is(ref($Document), ref($clone), "Same class"); Test::More::is_deeply( $Document, $clone, "Deeply equal" ); { my $isa = $clone->find_first(sub { $_[1] eq '@ISA'; }); Test::More::ok($isa, "Found ISA var"); Test::More::is($isa->parent, q|@ISA = (qw/File::Spec/);|, "Got parent ok"); # <-- this one fails } } PPI-1.278/t/ppi_token_quote_double.t0000644000175000017500000000407114573465137016017 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Quote::Double use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 22 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; INTERPOLATIONS: { # Get a set of objects my $Document = safe_new \<<'END_PERL'; "no interpolations" "no \@interpolations" "has $interpolation" "has @interpolation" "has \\@interpolation" "" # False content to test double-negation scoping END_PERL my $strings = $Document->find('Token::Quote::Double'); is( scalar @{$strings}, 6, 'Found the 6 test strings' ); is( $strings->[0]->interpolations, '', 'String 1: No interpolations' ); is( $strings->[1]->interpolations, '', 'String 2: No interpolations' ); is( $strings->[2]->interpolations, 1, 'String 3: Has interpolations' ); is( $strings->[3]->interpolations, 1, 'String 4: Has interpolations' ); is( $strings->[4]->interpolations, 1, 'String 5: Has interpolations' ); is( $strings->[5]->interpolations, '', 'String 6: No interpolations' ); } SIMPLIFY: { my $Document = safe_new \<<'END_PERL'; "no special characters" "has \"double\" quotes" "has 'single' quotes" "has $interpolation" "has @interpolation" "" END_PERL my $strings = $Document->find('Token::Quote::Double'); is( scalar @{$strings}, 6, 'Found the 6 test strings' ); is( $strings->[0]->simplify, q<'no special characters'>, 'String 1: No special characters' ); is( $strings->[1]->simplify, q<"has \"double\" quotes">, 'String 2: Double quotes' ); is( $strings->[2]->simplify, q<"has 'single' quotes">, 'String 3: Single quotes' ); is( $strings->[3]->simplify, q<"has $interpolation">, 'String 3: Has interpolation' ); is( $strings->[4]->simplify, q<"has @interpolation">, 'String 4: Has interpolation' ); is( $strings->[5]->simplify, q<''>, 'String 6: Empty string' ); } STRING: { my $Document = safe_new \'print "foo";'; my $Double = $Document->find_first('Token::Quote::Double'); isa_ok( $Double, 'PPI::Token::Quote::Double' ); is( $Double->string, 'foo', '->string returns as expected' ); } PPI-1.278/t/21_exhaustive.t0000644000175000017500000001202614573465137013746 0ustar olafolaf#!/usr/bin/perl # Exhaustively test all possible Perl programs to a particular length use lib 't/lib'; use PPI::Test::pragmas; use Test::More; # Plan comes later use Params::Util qw( _INSTANCE ); use PPI (); use PPI::Test qw( quotable ); use Helper 'safe_new'; # When distributing, keep this in to verify the test script # is working correctly, but limit to 2 (maaaaybe 3) so we # don't slow the install process down too much. my ( $MAX_CHARS, $ITERATIONS, $LENGTH ) = ( 2, 1000, 190 ); my @ALL_CHARS = ( qw{a b c f g m q r s t w x y z V W X 0 1 8 9}, ';', '[', ']', '{', '}', '(', ')', '=', '?', '|', '+', '<', '>', '.', '!', '~', '^', '*', '$', '@', '&', ':', '%', ',', '\\', '/', '_', ' ', "\n", "\t", '-', "'", '"', '`', '#', # Comment out to make parsing more intense ); # Cases known to have failed in the past. my @FAILURES = ( # Failed cases 3 chars or less '!%:', '!%:', '!%:', '!%:', '!*:', '!@:', '%:', '%:,', '%:;', '*:', '*:,', '*::', '*:;', '+%:', '+*:', '+@:', '-%:', '-*:', '-@:', ';%:', ';*:', ';@:', '@:', '@:,', '@::', '@:;', '\%:', '\&:', '\*:', '\@:', '~%:', '~*:', '~@:', '(<', '(<', '=<', 'm(', 'm(', 'm<', 'm[', 'm{', 'q(', 'q<', 'q[', 'q{', 's(', 's<', 's[', 's{', 'y(', 'y<', 'y[', 'y{', '$\'0', '009', '0bB', '0xX', '009;', '0bB;', '0xX;', "<<'", '<<"', '<<`', '&::', '<s', 's<>-', '*::0', '*::1', '*:::', '*::\'', '$::0', '$:::', '$::\'', '@::0', '@::1', '@:::', '&::0', '&::\'', '%:::', '%::\'', # More-specific single cases thrown up during the heavy testing '$:::z', '*:::z', "\\\@::'9:!", "} mz}~<\nV", "( {8", ); plan tests => (9722 + ($ENV{AUTHOR_TESTING} ? 1 : 0)); ##################################################################### # Code/Dump Testing my $last_index = scalar(@ALL_CHARS) - 1; LENGTHLOOP: foreach my $len ( 1 .. $MAX_CHARS ) { # Initialise the char array my @chars = (0) x $len; # The main test loop my $failures = 0; # simulate subtests CHARLOOP: while ( 1 ) { # Test the current set of chars my $code = join '', map { $ALL_CHARS[$_] } @chars; unless ( length($code) == $len ) { die "Failed sanity check. Error in the code generation mechanism"; } $failures += 1 if !compare_code( $code ); # Increment the last character $chars[$len - 1]++; # Cascade the wrapping as needed foreach ( reverse( 0 .. $len - 1 ) ) { next CHARLOOP unless $chars[$_] > $last_index; if ( $_ == 0 ) { # End of the iterations, move to the next length last CHARLOOP; } # Carry to the previous char $chars[$_] = 0; $chars[$_ - 1]++; } } is( $failures, 0, "No tokenizer failures for all $len-length programs" ); } ##################################################################### # Test a series of random strings for ( 1 .. $ITERATIONS ) { # Generate a random string my $code = join( '', map { $ALL_CHARS[$_] } map { int(rand($last_index) + 1) } (1 .. $LENGTH) ); ok( compare_code($code), "round trip successful" ); } ##################################################################### # Test all the failures foreach my $code ( @FAILURES ) { ok( compare_code($code), "round trip of old failure successful" ); } exit(0); ##################################################################### # Support Functions sub compare_code { my ( $code ) = @_; my $round_tripped = round_trip_code($code); my $ok = ($code eq $round_tripped); if ( !$ok ) { my $code_quoted = quotable($code); diag( qq{input: "$code_quoted"} ); my $round_tripped_quoted = quotable($round_tripped); diag( qq{output: "$round_tripped_quoted"} ); my $shortest = quotable(quickcheck($code)); diag( qq{shorted failing substring: "$shortest"} ); } if ( scalar(keys %PPI::Element::PARENT) != 0 ) { $ok = 0; my $code_quoted = quotable($code); diag( qq{ Stale \%PARENT entries at the end of testing of "$code_quoted"} ); } %PPI::Element::PARENT = %PPI::Element::PARENT; return $ok; } sub round_trip_code { my ( $code ) = @_; my $result; my $Document = eval { # use Carp 'croak'; $SIG{__WARN__} = sub { croak('Triggered a warning') }; safe_new \$code; }; if ( _INSTANCE($Document, 'PPI::Document') ) { $result = $Document->serialize; } return $result; } # Find the shortest failing substring of known bad string sub quickcheck { my $code = shift; my $fails = $code; # use Carp 'croak'; $SIG{__WARN__} = sub { croak('Triggered a warning') }; while ( length $fails ) { chop $code; safe_new \$code or last; $fails = $code; } while ( length $fails ) { substr( $code, 0, 1, '' ); safe_new \$code or return $fails; $fails = $code; } return $fails; } PPI-1.278/t/ppi_token_unknown.t0000644000175000017500000005621714573465137015040 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Unknown use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 2328 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use B qw( perlstring ); use Helper 'safe_new'; our %known_bad_seps; OPERATOR_CAST: { my @nothing = ( '', [] ); my @number = ( '1', [ 'PPI::Token::Number' => '1' ] ); my @asterisk_op = ( '*', [ 'PPI::Token::Operator' => '*' ] ); my @asteriskeq_op = ( '*=', [ 'PPI::Token::Operator' => '*=' ] ); my @percent_op = ( '%', [ 'PPI::Token::Operator' => '%' ] ); my @percenteq_op = ( '%=', [ 'PPI::Token::Operator' => '%=' ] ); my @ampersand_op = ( '&', [ 'PPI::Token::Operator' => '&' ] ); my @ampersandeq_op = ( '&=', [ 'PPI::Token::Operator' => '&=' ] ); my @exp_op = ( '**', [ 'PPI::Token::Operator' => '**' ] ); my @asterisk_cast = ( '*', [ 'PPI::Token::Cast' => '*' ] ); my @percent_cast = ( '%', [ 'PPI::Token::Cast' => '%' ] ); my @ampersand_cast = ( '&', [ 'PPI::Token::Cast' => '&' ] ); my @at_cast = ( '@', [ 'PPI::Token::Cast' => '@' ] ); my @scalar = ( '$a', [ 'PPI::Token::Symbol' => '$a' ] ); my @list = ( '@a', [ 'PPI::Token::Symbol' => '@a' ] ); my @hash = ( '%a', [ 'PPI::Token::Symbol' => '%a' ] ); my @glob = ( '*a', [ 'PPI::Token::Symbol' => '*a' ] ); my @bareword = ( 'word', [ 'PPI::Token::Word' => 'word' ] ); my @hashctor1 = ( '{2}', [ # 'PPI::Structure::Constructor' => '{2}', 'PPI::Structure::Block' => '{2}', # should be constructor 'PPI::Token::Structure' => '{', # 'PPI::Statement::Expression' => '2', 'PPI::Statement' => '2', # should be expression 'PPI::Token::Number' => '2', 'PPI::Token::Structure' => '}', ] ); my @hashctor2 = ( '{x=>2}', [ # 'PPI::Structure::Constructor' => '{x=>2}', 'PPI::Structure::Block' => '{x=>2}', # should be constructor 'PPI::Token::Structure' => '{', # 'PPI::Statement::Expression' => 'x=>2', 'PPI::Statement' => 'x=>2', # should be expression 'PPI::Token::Word' => 'x', 'PPI::Token::Operator' => '=>', 'PPI::Token::Number' => '2', 'PPI::Token::Structure' => '}', ] ); my @hashctor3 = ( '{$args}', [ # 'PPI::Structure::Constructor' => '{$args}', 'PPI::Structure::Block' => '{$args}', # should be constructor 'PPI::Token::Structure' => '{', # 'PPI::Statement::Expression' => '$args', 'PPI::Statement' => '$args', # should be expression 'PPI::Token::Symbol' => '$args', 'PPI::Token::Structure' => '}', ] ); my @listctor = ( '[$args]', [ 'PPI::Structure::Constructor' => '[$args]', 'PPI::Token::Structure' => '[', # 'PPI::Statement::Expression' => '$args', 'PPI::Statement' => '$args', # should be expression 'PPI::Token::Symbol' => '$args', 'PPI::Token::Structure' => ']', ] ); test_varying_whitespace( @number, @asterisk_op, @scalar ); test_varying_whitespace( @number, @asterisk_op, @list ); test_varying_whitespace( @number, @asterisk_op, @hash ); test_varying_whitespace( @number, @asterisk_op, @hashctor1 ); test_varying_whitespace( @number, @asterisk_op, @hashctor2 ); test_varying_whitespace( @number, @asterisk_op, @hashctor3 ); test_varying_whitespace( @number, @exp_op, @bareword ); test_varying_whitespace( @number, @exp_op, @hashctor3 ); # doesn't compile, but make sure ** is operator test_varying_whitespace( @number, @asteriskeq_op, @bareword ); test_varying_whitespace( @number, @asteriskeq_op, @hashctor3 ); # doesn't compile, but make sure it's an operator { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @nothing, @asterisk_cast, @scalar ); } test_varying_whitespace( @number, @percent_op, @scalar ); test_varying_whitespace( @number, @percent_op, @list ); test_varying_whitespace( @number, @percent_op, @hash ); test_varying_whitespace( @number, @percent_op, @glob ); test_varying_whitespace( @number, @percent_op, @hashctor1 ); test_varying_whitespace( @number, @percent_op, @hashctor2 ); test_varying_whitespace( @number, @percent_op, @hashctor3 ); test_varying_whitespace( @number, @percenteq_op, @bareword ); test_varying_whitespace( @number, @percenteq_op, @hashctor3 ); # doesn't compile, but make sure it's an operator { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @nothing, @percent_cast, @scalar ); } test_varying_whitespace( @number, @ampersand_op, @scalar ); test_varying_whitespace( @number, @ampersand_op, @list ); test_varying_whitespace( @number, @ampersand_op, @hash ); test_varying_whitespace( @number, @ampersand_op, @glob ); test_varying_whitespace( @number, @ampersand_op, @hashctor1 ); test_varying_whitespace( @number, @ampersand_op, @hashctor2 ); test_varying_whitespace( @number, @ampersand_op, @hashctor3 ); test_varying_whitespace( @number, @ampersandeq_op, @bareword ); test_varying_whitespace( @number, @ampersandeq_op, @hashctor3 ); # doesn't compile, but make sure it's an operator { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @nothing, @ampersand_cast, @scalar ); } my @plus = ( '+', [ 'PPI::Token::Operator' => '+', ] ); my @ex = ( 'x', [ 'PPI::Token::Word' => 'x', ] ); { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @plus, @asterisk_cast, @scalar ); test_varying_whitespace( @plus, @asterisk_cast, @hashctor3 ); test_varying_whitespace( @plus, @percent_cast, @scalar ); test_varying_whitespace( @plus, @percent_cast, @hashctor3 ); test_varying_whitespace( @plus, @ampersand_cast, @scalar ); test_varying_whitespace( @plus, @ampersand_cast, @hashctor3 ); test_varying_whitespace( @ex, @asterisk_cast, @scalar ); test_varying_whitespace( @ex, @asterisk_cast, @hashctor3 ); test_varying_whitespace( @ex, @percent_cast, @scalar ); test_varying_whitespace( @ex, @percent_cast, @hashctor3 ); test_varying_whitespace( @ex, @ampersand_cast, @scalar ); test_varying_whitespace( @ex, @ampersand_cast, @hashctor3 ); } my @single = ( "'3'", [ 'PPI::Token::Quote::Single' => "'3'", ] ); test_varying_whitespace( @single, @asterisk_op, @scalar ); test_varying_whitespace( @single, @asterisk_op, @hashctor3 ); test_varying_whitespace( @single, @percent_op, @scalar ); test_varying_whitespace( @single, @percent_op, @hashctor3 ); test_varying_whitespace( @single, @ampersand_op, @scalar ); test_varying_whitespace( @single, @ampersand_op, @hashctor3 ); my @double = ( '"3"', [ 'PPI::Token::Quote::Double' => '"3"', ] ); test_varying_whitespace( @double, @asterisk_op, @scalar ); test_varying_whitespace( @double, @asterisk_op, @hashctor3 ); test_varying_whitespace( @double, @percent_op, @scalar ); test_varying_whitespace( @double, @percent_op, @hashctor3 ); test_varying_whitespace( @double, @ampersand_op, @scalar ); test_varying_whitespace( @double, @ampersand_op, @hashctor3 ); test_varying_whitespace( @scalar, @asterisk_op, @scalar ); test_varying_whitespace( @scalar, @percent_op, @scalar ); test_varying_whitespace( @scalar, @ampersand_op, @scalar ); my @package = ( 'package foo {}', [ 'PPI::Statement::Package' => 'package foo {}', 'PPI::Token::Word' => 'package', 'PPI::Token::Word' => 'foo', 'PPI::Structure::Block' => '{}', 'PPI::Token::Structure' => '{', 'PPI::Token::Structure' => '}', ] ); { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @package, @asterisk_cast, @scalar, 1 ); test_varying_whitespace( @package, @asterisk_cast, @hashctor3, 1 ); test_varying_whitespace( @package, @percent_cast, @scalar, 1 ); test_varying_whitespace( @package, @percent_cast, @hashctor3, 1 ); test_varying_whitespace( @package, @ampersand_cast, @scalar, 1 ); test_varying_whitespace( @package, @ampersand_cast, @hashctor3, 1 ); } test_varying_whitespace( @package, @at_cast, @scalar, 1 ); test_varying_whitespace( @package, @at_cast, @listctor, 1 ); my @sub = ( 'sub foo {}', [ 'PPI::Statement::Sub' => 'sub foo {}', 'PPI::Token::Word' => 'sub', 'PPI::Token::Word' => 'foo', 'PPI::Structure::Block' => '{}', 'PPI::Token::Structure' => '{', 'PPI::Token::Structure' => '}', ] ); { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @sub, @asterisk_cast, @scalar, 1 ); test_varying_whitespace( @sub, @asterisk_cast, @hashctor3, 1 ); test_varying_whitespace( @sub, @percent_cast, @scalar, 1 ); test_varying_whitespace( @sub, @percent_cast, @hashctor3, 1 ); test_varying_whitespace( @sub, @ampersand_cast, @scalar, 1 ); test_varying_whitespace( @sub, @ampersand_cast, @hashctor3, 1 ); } test_varying_whitespace( @sub, @at_cast, @scalar, 1 ); test_varying_whitespace( @sub, @at_cast, @listctor, 1 ); my @statement = ( '1;', [ 'PPI::Statement' => '1;', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => ';', ] ); { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @statement, @asterisk_cast, @scalar, 1 ); test_varying_whitespace( @statement, @asterisk_cast, @hashctor3, 1 ); test_varying_whitespace( @statement, @percent_cast, @scalar, 1 ); test_varying_whitespace( @statement, @percent_cast, @hashctor3, 1 ); test_varying_whitespace( @statement, @ampersand_cast, @scalar, 1 ); test_varying_whitespace( @statement, @ampersand_cast, @hashctor3, 1 ); } test_varying_whitespace( @statement, @at_cast, @scalar, 1 ); test_varying_whitespace( @statement, @at_cast, @listctor, 1 ); my @label = ( 'LABEL:', [ 'PPI::Statement::Compound' => 'LABEL:', 'PPI::Token::Label' => 'LABEL:', ] ); { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @label, @asterisk_cast, @scalar, 1 ); test_varying_whitespace( @label, @asterisk_cast, @hashctor3, 1 ); test_varying_whitespace( @label, @percent_cast, @scalar, 1 ); test_varying_whitespace( @label, @percent_cast, @hashctor3, 1 ); test_varying_whitespace( @label, @ampersand_cast, @scalar, 1 ); test_varying_whitespace( @label, @ampersand_cast, @hashctor3, 1 ); } test_varying_whitespace( @label, @at_cast, @scalar, 1 ); test_varying_whitespace( @label, @at_cast, @listctor, 1 ); my @map = ( 'map {1}', [ 'PPI::Token::Word' => 'map', 'PPI::Structure::Block' => '{1}', 'PPI::Token::Structure' => '{', 'PPI::Statement' => '1', 'PPI::Token::Number' => '1', 'PPI::Token::Structure' => '}', ] ); { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( @map, @asterisk_cast, @scalar ); test_varying_whitespace( @map, @asterisk_cast, @hashctor3 ); test_varying_whitespace( @map, @percent_cast, @scalar ); test_varying_whitespace( @map, @percent_cast, @hashctor3 ); test_varying_whitespace( @map, @ampersand_cast, @scalar ); test_varying_whitespace( @map, @ampersand_cast, @hashctor3 ); } test_varying_whitespace( @map, @at_cast, @scalar ); test_varying_whitespace( @map, @at_cast, @listctor ); my @evalblock = ( 'eval {2}', [ 'PPI::Token::Word' => 'eval', 'PPI::Structure::Block' => '{2}', 'PPI::Token::Structure' => '{', 'PPI::Statement' => '2', 'PPI::Token::Number' => '2', 'PPI::Token::Structure' => '}', ] ); test_varying_whitespace( @evalblock, @asterisk_op, @scalar ); test_varying_whitespace( @double, @asterisk_op, @hashctor3 ); test_varying_whitespace( @evalblock, @percent_op, @scalar ); test_varying_whitespace( @evalblock, @percent_op, @hashctor3 ); test_varying_whitespace( @evalblock, @ampersand_op, @scalar ); test_varying_whitespace( @evalblock, @ampersand_op, @hashctor3 ); my @evalstring = ( 'eval "2"', [ 'PPI::Token::Word' => 'eval', 'PPI::Token::Quote::Double' => '"2"', ] ); test_varying_whitespace( @evalstring, @asterisk_op, @scalar ); test_varying_whitespace( @evalstring, @asterisk_op, @hashctor3 ); test_varying_whitespace( @evalstring, @percent_op, @scalar ); test_varying_whitespace( @evalstring, @percent_op, @hashctor3 ); test_varying_whitespace( @evalstring, @ampersand_op, @scalar ); test_varying_whitespace( @evalstring, @ampersand_op, @hashctor3 ); my @curly_subscript1 = ( '$y->{x}', [ 'PPI::Token::Symbol' => '$y', 'PPI::Token::Operator' => '->', 'PPI::Structure::Subscript' => '{x}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => 'x', 'PPI::Token::Word' => 'x', 'PPI::Token::Structure' => '}', ] ); my @curly_subscript2 = ( '$y->{z}{x}', [ 'PPI::Token::Symbol' => '$y', 'PPI::Token::Operator' => '->', 'PPI::Structure::Subscript' => '{z}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => 'z', 'PPI::Token::Word' => 'z', 'PPI::Token::Structure' => '}', 'PPI::Structure::Subscript' => '{x}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => 'x', 'PPI::Token::Word' => 'x', 'PPI::Token::Structure' => '}', ] ); my @curly_subscript3 = ( '$y->[z]{x}', [ 'PPI::Token::Symbol' => '$y', 'PPI::Token::Operator' => '->', 'PPI::Structure::Subscript' => '[z]', 'PPI::Token::Structure' => '[', 'PPI::Statement::Expression' => 'z', 'PPI::Token::Word' => 'z', 'PPI::Token::Structure' => ']', 'PPI::Structure::Subscript' => '{x}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => 'x', 'PPI::Token::Word' => 'x', 'PPI::Token::Structure' => '}', ] ); my @square_subscript1 = ( '$y->[x]', [ 'PPI::Token::Symbol' => '$y', 'PPI::Token::Operator' => '->', 'PPI::Structure::Subscript' => '[x]', 'PPI::Token::Structure' => '[', 'PPI::Statement::Expression' => 'x', 'PPI::Token::Word' => 'x', 'PPI::Token::Structure' => ']', ] ); test_varying_whitespace( @curly_subscript1, @asterisk_op, @scalar ); test_varying_whitespace( @curly_subscript1, @percent_op, @scalar ); test_varying_whitespace( @curly_subscript1, @ampersand_op, @scalar ); test_varying_whitespace( @curly_subscript2, @asterisk_op, @scalar ); test_varying_whitespace( @curly_subscript2, @percent_op, @scalar ); test_varying_whitespace( @curly_subscript2, @ampersand_op, @scalar ); test_varying_whitespace( @curly_subscript3, @asterisk_op, @scalar ); test_varying_whitespace( @curly_subscript3, @percent_op, @scalar ); test_varying_whitespace( @curly_subscript3, @ampersand_op, @scalar ); test_varying_whitespace( @square_subscript1, @asterisk_op, @scalar ); test_varying_whitespace( @square_subscript1, @percent_op, @scalar ); test_varying_whitespace( @square_subscript1, @ampersand_op, @scalar ); { local %known_bad_seps = map { $_ => 1 } qw( space ); test_varying_whitespace( 'keys', [ 'PPI::Token::Word' => 'keys' ], @percent_cast, @scalar ); test_varying_whitespace( 'values', [ 'PPI::Token::Word' => 'values' ], @percent_cast, @scalar ); test_varying_whitespace( 'keys', [ 'PPI::Token::Word' => 'keys' ], @percent_cast, @hashctor3 ); test_varying_whitespace( 'values', [ 'PPI::Token::Word' => 'values' ], @percent_cast, @hashctor3 ); } test_statement( '} *$a', # unbalanced '}' before '*', arbitrary decision [ 'PPI::Statement::UnmatchedBrace' => '}', 'PPI::Token::Structure' => '}', 'PPI::Statement' => '*$a', 'PPI::Token::Operator' => '*', 'PPI::Token::Symbol' => '$a', ] ); test_statement( '$bar = \%*$foo', # multiple consecutive casts [ 'PPI::Token::Symbol' => '$bar', 'PPI::Token::Operator' => '=', 'PPI::Token::Cast' => '\\', 'PPI::Token::Cast' => '%', 'PPI::Token::Cast' => '*', 'PPI::Token::Symbol' => '$foo', ] ); test_statement( '$#tmp*$#tmp2', [ 'PPI::Token::ArrayIndex' => '$#tmp', 'PPI::Token::Operator' => '*', 'PPI::Token::ArrayIndex' => '$#tmp2', ] ); test_statement( '[ %{$req->parameters} ]', # preceded by '[' [ 'PPI::Structure::Constructor' => '[ %{$req->parameters} ]', 'PPI::Token::Structure' => '[', 'PPI::Statement' => '%{$req->parameters}', 'PPI::Token::Cast' => '%', 'PPI::Structure::Block' => '{$req->parameters}', 'PPI::Token::Structure' => '{', 'PPI::Statement' => '$req->parameters', 'PPI::Token::Symbol' => '$req', 'PPI::Token::Operator' => '->', 'PPI::Token::Word' => 'parameters', 'PPI::Token::Structure' => '}', 'PPI::Token::Structure' => ']', ] ); test_statement( '( %{$req->parameters} )', # preceded by '(' [ 'PPI::Structure::List' => '( %{$req->parameters} )', 'PPI::Token::Structure' => '(', 'PPI::Statement::Expression' => '%{$req->parameters}', 'PPI::Token::Cast' => '%', 'PPI::Structure::Block' => '{$req->parameters}', 'PPI::Token::Structure' => '{', 'PPI::Statement' => '$req->parameters', 'PPI::Token::Symbol' => '$req', 'PPI::Token::Operator' => '->', 'PPI::Token::Word' => 'parameters', 'PPI::Token::Structure' => '}', 'PPI::Token::Structure' => ')', ] ); test_statement( '++$i%$f', # '%' wrongly a cast through 1.220. [ 'PPI::Statement' => '++$i%$f', 'PPI::Token::Operator' => '++', 'PPI::Token::Symbol' => '$i', 'PPI::Token::Operator' => '%', 'PPI::Token::Symbol' => '$f', ] ); # Postfix dereference test_statement( '$foo->$*', [ 'PPI::Statement' => '$foo->$*', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '$*', ] ); test_statement( '$foo->@*', [ 'PPI::Statement' => '$foo->@*', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '@*', ] ); test_statement( '$foo->$#*', [ 'PPI::Statement' => '$foo->$#*', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '$#*', ] ); test_statement( '$foo->%*', [ 'PPI::Statement' => '$foo->%*', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '%*', ] ); test_statement( '$foo->&*', [ 'PPI::Statement' => '$foo->&*', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '&*', ] ); test_statement( '$foo->**', [ 'PPI::Statement' => '$foo->**', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '**', ] ); test_statement( '$foo->@[0]', [ 'PPI::Statement' => '$foo->@[0]', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '@', 'PPI::Structure::Subscript' => '[0]', 'PPI::Token::Structure' => '[', 'PPI::Statement::Expression' => '0', 'PPI::Token::Number' => '0', 'PPI::Token::Structure' => ']', ] ); test_statement( '$foo->@{0}', [ 'PPI::Statement' => '$foo->@{0}', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '@', 'PPI::Structure::Subscript' => '{0}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => '0', 'PPI::Token::Number' => '0', 'PPI::Token::Structure' => '}', ] ); test_statement( '$foo->%["bar"]', [ 'PPI::Statement' => '$foo->%["bar"]', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '%', 'PPI::Structure::Subscript' => '["bar"]', 'PPI::Token::Structure' => '[', 'PPI::Statement::Expression' => '"bar"', 'PPI::Token::Quote::Double' => '"bar"', 'PPI::Token::Structure' => ']', ] ); test_statement( '$foo->%{bar}', [ 'PPI::Statement' => '$foo->%{bar}', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '%', 'PPI::Structure::Subscript' => '{bar}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => 'bar', 'PPI::Token::Word' => 'bar', 'PPI::Token::Structure' => '}', ] ); test_statement( '$foo->*{CODE}', [ 'PPI::Statement' => '$foo->*{CODE}', 'PPI::Token::Symbol' => '$foo', 'PPI::Token::Operator' => '->', 'PPI::Token::Cast' => '*', 'PPI::Structure::Subscript' => '{CODE}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => 'CODE', 'PPI::Token::Word' => 'CODE', 'PPI::Token::Structure' => '}', ] ); { # these need to be fixed in PPI::Lexer->_statement, fixing these will break other tests that need to be changed local $TODO = "clarify type of statement in constructor"; test_statement( '[$args]', [ 'PPI::Structure::Constructor' => '[$args]', 'PPI::Token::Structure' => '[', 'PPI::Statement::Expression' => '$args', 'PPI::Token::Symbol' => '$args', 'PPI::Token::Structure' => ']', ] ); test_statement( '{$args}', [ 'PPI::Structure::Constructor' => '{$args}', 'PPI::Token::Structure' => '{', 'PPI::Statement::Expression' => '$args', 'PPI::Token::Symbol' => '$args', 'PPI::Token::Structure' => '}', ] ); local $TODO = "hash constructors are currently mistaken for blocks"; test_statement( '1 * {2}', [ 'PPI::Token::Number' => '1' , 'PPI::Token::Operator' => '*', 'PPI::Structure::Constructor' => '{2}', 'PPI::Token::Structure' => '{', 'PPI::Statement' => '2', 'PPI::Token::Number' => '2', 'PPI::Token::Structure' => '}', ] ) } } sub one_line_explain { my ($data) = @_; my @explain = explain $data; s/\n//g for @explain; return join "", @explain; } sub main_level_line { return "" if not $TODO; my @outer_final; my $level = 0; while ( my @outer = caller($level++) ) { @outer_final = @outer; } return "l $outer_final[2] - "; } sub test_statement { local $Test::Builder::Level = $Test::Builder::Level+1; my ( $code, $expected, $msg ) = @_; $msg = perlstring $code if !defined $msg; my $d = safe_new \$code; my $tokens = $d->find( sub { $_[1]->significant } ); $tokens = [ map { ref($_), $_->content } @$tokens ]; if ( $expected->[0] !~ /^PPI::Statement/ ) { $expected = [ 'PPI::Statement', $code, @$expected ]; } my $ok = is_deeply( $tokens, $expected, main_level_line.$msg ); if ( !$ok ) { diag ">>> $code -- $msg\n"; diag one_line_explain $tokens; diag one_line_explain $expected; } return; } sub test_varying_whitespace { local $Test::Builder::Level = $Test::Builder::Level+1; my( $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ) = @_; { local $TODO = "known bug" if $known_bad_seps{null}; assemble_and_test( "", $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ); } { local $TODO = "known bug" if $known_bad_seps{space}; assemble_and_test( " ", $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ); assemble_and_test( "\t", $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ); assemble_and_test( "\n", $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ); assemble_and_test( "\f", $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ); } local $TODO = "\\r is being nuked to \\n, need to fix that first"; assemble_and_test( "\r", $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ); # fix this -- different breakage from \n, \t, etc. return; } sub assemble_and_test { local $Test::Builder::Level = $Test::Builder::Level+1; my( $whitespace, $left, $left_expected, $cast_or_op, $cast_or_op_expected, $right, $right_expected, $right_is_statement ) = @_; my $code = $left eq '' ? "$cast_or_op$whitespace$right" : "$left$whitespace$cast_or_op$whitespace$right"; if ( $right_is_statement ) { $cast_or_op_expected = [ 'PPI::Statement' => "$cast_or_op$whitespace$right", @$cast_or_op_expected ]; } my $expected = [ @$left_expected, @$cast_or_op_expected, @$right_expected, ]; test_statement( $code, $expected ); return; } PPI-1.278/t/ppi_lexer.t0000644000175000017500000001332314573465137013247 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Lexer use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 49 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; UNMATCHED_BRACE: { my $token = new_ok( 'PPI::Token::Structure' => [ ')' ] ); my $brace = new_ok( 'PPI::Statement::UnmatchedBrace' => [ $token ] ); is( $brace->content, ')', '->content ok' ); } _CURLY: { my $document = safe_new \<<'END_PERL'; use constant { One => 1 }; use constant 1 { One => 1 }; $foo->{bar}; $foo[1]{bar}; $foo{bar}; sub {1}; grep { $_ } 0 .. 2; map { $_ => 1 } 0 .. 2; sort { $b <=> $a } 0 .. 2; do {foo}; $foo = { One => 1 }; $foo ||= { One => 1 }; 1, { One => 1 }; One => { Two => 2 }; {foo, bar}; {foo => bar}; {}; +{foo, bar}; {; => bar}; @foo{'bar', 'baz'}; @{$foo}{'bar', 'baz'}; ${$foo}{bar}; return { foo => 'bar' }; bless { foo => 'bar' }; $foo &&= { One => 1 }; $foo //= { One => 1 }; $foo //= { 'a' => 1, 'b' => 2 }; 0 || { One => 1 }; 1 && { One => 1 }; undef // { One => 1 }; $x ? {a=>1} : 1; $x ? 1 : {a=>1}; $x ? {a=>1} : {b=>1}; CHECK { foo() } open( CHECK, '/foo' ); END_PERL $document->index_locations(); my @statements; foreach my $elem ( @{ $document->find( 'PPI::Statement' ) || [] } ) { $statements[ $elem->line_number() - 1 ] ||= $elem; } is( scalar(@statements), 35, 'Found 35 statements' ); isa_ok( $statements[0]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[0]); isa_ok( $statements[1]->schild(3), 'PPI::Structure::Constructor', 'The curly in ' . $statements[1]); isa_ok( $statements[2]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[2]); isa_ok( $statements[3]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[3]); isa_ok( $statements[4]->schild(1), 'PPI::Structure::Subscript', 'The curly in ' . $statements[4]); isa_ok( $statements[5]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[5]); isa_ok( $statements[6]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[6]); isa_ok( $statements[7]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[7]); isa_ok( $statements[8]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[8]); isa_ok( $statements[9]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[9]); isa_ok( $statements[10]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[10]); isa_ok( $statements[11]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[11]); isa_ok( $statements[12]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[12]); isa_ok( $statements[13]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[13]); isa_ok( $statements[14]->schild(0), 'PPI::Structure::Block', 'The curly in ' . $statements[14]); isa_ok( $statements[15]->schild(0), 'PPI::Structure::Constructor', 'The curly in ' . $statements[15]); isa_ok( $statements[16]->schild(0), 'PPI::Structure::Constructor', 'The curly in ' . $statements[16]); isa_ok( $statements[17]->schild(1), 'PPI::Structure::Constructor', 'The curly in ' . $statements[17]); isa_ok( $statements[18]->schild(0), 'PPI::Structure::Block', 'The curly in ' . $statements[18]); isa_ok( $statements[19]->schild(1), 'PPI::Structure::Subscript', 'The curly in ' . $statements[19]); isa_ok( $statements[20]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[20]); isa_ok( $statements[21]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[21]); isa_ok( $statements[22]->schild(1), 'PPI::Structure::Constructor', 'The curly in ' . $statements[22]); isa_ok( $statements[23]->schild(1), 'PPI::Structure::Constructor', 'The curly in ' . $statements[23]); isa_ok( $statements[24]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[24]); isa_ok( $statements[25]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[25]); isa_ok( $statements[26]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[26]); isa_ok( $statements[27]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[27]); isa_ok( $statements[28]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[28]); isa_ok( $statements[29]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[29]); isa_ok( $statements[30]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[30]); isa_ok( $statements[31]->schild(4), 'PPI::Structure::Constructor', 'The curly in ' . $statements[31]); # Check two things in the same statement isa_ok( $statements[32]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[32]); isa_ok( $statements[32]->schild(4), 'PPI::Structure::Constructor', 'The curly in ' . $statements[32]); # Scheduled block (or not) isa_ok( $statements[33], 'PPI::Statement::Scheduled', 'Scheduled block in ' . $statements[33]); isa_ok( $statements[34]->schild(1)->schild(0), 'PPI::Statement::Expression', 'Expression (not scheduled block) in ' . $statements[34]); } LEX_STRUCTURE: { # Validate the creation of a null statement SCOPE: { my $token = new_ok( 'PPI::Token::Structure' => [ ';' ] ); my $null = new_ok( 'PPI::Statement::Null' => [ $token ] ); is( $null->content, ';', '->content ok' ); } # Validate the creation of an empty statement new_ok( 'PPI::Statement' => [ ] ); } ERROR_HANDLING: { my $test_lexer = PPI::Lexer->new; is $test_lexer->errstr, "", "errstr is an empty string at the start"; is $test_lexer->lex_file( undef ), undef, "lex_file fails without a filename"; is( PPI::Lexer->errstr, "Did not pass a filename to PPI::Lexer::lex_file", "error can be gotten from class attribute" ); } PPI-1.278/t/05_lexer.t0000644000175000017500000000067214573465137012706 0ustar olafolaf#!/usr/bin/perl # Compare a large number of specific code samples (.code) # with the expected Lexer dumps (.dump). use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 236 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catdir ); use PPI::Test::Run (); ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir( catdir( 't', 'data', '05_lexer' ) ); PPI-1.278/t/28_foreach_qw.t0000644000175000017500000000241414573465137013706 0ustar olafolaf#!/usr/bin/perl # Standalone tests to check "foreach qw{foo} {}" use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 15 + ($ENV{AUTHOR_TESTING} ? 1 : 0); #use File::Spec::Functions ':ALL'; use PPI (); use Helper 'safe_new'; ##################################################################### # Parse the canonical cases SCOPE: { my $string = 'for qw{foo} {} foreach'; my $document = safe_new \$string; my $statements = $document->find('Statement::Compound'); is( scalar(@$statements), 2, 'Found 2 statements' ); is( $statements->[0]->type, 'foreach', '->type ok' ); is( $statements->[1]->type, 'foreach', '->type ok' ); } SCOPE: { my $string = 'foreach qw{foo} {} foreach'; my $document = safe_new \$string; my $statements = $document->find('Statement::Compound'); is( scalar(@$statements), 2, 'Found 2 statements' ); is( $statements->[0]->type, 'foreach', '->type ok' ); is( $statements->[1]->type, 'foreach', '->type ok' ); } SCOPE: { my $string = 'for my $foo qw{bar} {} foreach'; my $document = safe_new \$string; my $statements = $document->find('Statement::Compound'); is( scalar(@$statements), 2, 'Found 2 statements' ); is( $statements->[0]->type, 'foreach', '->type ok' ); is( $statements->[1]->type, 'foreach', '->type ok' ); } 1; PPI-1.278/t/08_regression.t0000644000175000017500000002221714573465137013751 0ustar olafolaf#!/usr/bin/perl # code/dump-style regression tests for known lexing problems. # Some other regressions tests are included here for simplicity. use if !(-e 'META.yml'), "Test::InDistDir"; use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 1085 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Test qw( pause ); use PPI::Test::Run (); use PPI::Singletons qw( %_PARENT ); use Helper 'safe_new'; ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir(qw{ t data 08_regression }); ##################################################################### # Regression Test for rt.cpan.org #11522 # Check that objects created in a foreach don't leak circulars. foreach ( 1 .. 3 ) { pause(); is( scalar(keys(%_PARENT)), 0, "No parent links at start of loop $_" ); # Keep the document from going out of scope before the _PARENT test below. my $Document = safe_new \q[print "Foo!"]; ## no critic ( Variables::ProhibitUnusedVarsStricter ) is( scalar(keys(%_PARENT)), 4, 'Correct number of keys created' ); } ##################################################################### # A number of things picked up during exhaustive testing I want to # watch for regressions on # Create a document with a complete braced regexp SCOPE: { my $Document = safe_new \"s {foo} i"; my $stmt = $Document->first_element; isa_ok( $stmt, 'PPI::Statement' ); my $regexp = $stmt->first_element; isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); # Check the regexp matches what we would expect (specifically # the fine details about the sections. my $expected = { _sections => 2, braced => 1, content => 's {foo} i', modifiers => { i => 1 }, operator => 's', sections => [ { position => 3, size => 3, type => '{}', }, { position => 9, size => 3, type => '<>', } ], separator => undef, }; is_deeply( { %$regexp }, $expected, 'Complex regexp matches expected' ); } # Also test the handling of a screwed up single part multi-regexp SCOPE: { my $Document = safe_new \"s {foo}_"; my $stmt = $Document->first_element; isa_ok( $stmt, 'PPI::Statement' ); my $regexp = $stmt->first_element; isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); # Check the internal details as before my $expected = { _sections => 2, _error => "No second section of regexp, or does not start with a balanced character", braced => 1, content => 's {foo}', modifiers => {}, operator => 's', sections => [ { position => 3, size => 3, type => '{}', }, { position => 7, size => 0, type => '', } ], separator => undef, }; is_deeply( { %$regexp }, $expected, 'Badly short regexp matches expected' ); } # Encode an assumption that the value of a zero-length substr one char # after the end of the string returns ''. This assumption is used to make # the decision on the sections->[1]->{position} value being one char after # the end of the current string is( substr('foo', 3, 0), '', 'substr one char after string end returns ""' ); # rt.cpan.org: Ticket #16671 $_ is not localized # Apparently I DID fix the localisation during parsing, but I forgot to # localise in PPI::Node::DESTROY (ack). $_ = 1234; is( $_, 1234, 'Set $_ to 1234' ); SCOPE: { my $Document = safe_new \"print 'Hello World';"; } is( $_, 1234, 'Remains after document creation and destruction' ); ##################################################################### # Bug 16815: location of Structure::List is not defined. SCOPE: { my $code = '@foo = (1,2)'; my $doc = safe_new \$code; ok( $doc->find_first('Structure::List')->location, '->location for a ::List returns true' ); } ##################################################################### # Bug 18413: PPI::Node prune() implementation broken SCOPE: { my $doc = safe_new \<<'END_PERL'; #!/usr/bin/perl use warnings; sub one { 1 } sub two { 2 } sub three { 3 } print one; print "\n"; print three; print "\n"; exit; END_PERL ok( defined $doc->prune('PPI::Statement::Sub'), '->prune ok' ); } ##################################################################### # Bug 19883: 'package' bareword used as hash key is detected as package statement SCOPE: { my $doc = safe_new \'(package => 123)'; isa_ok( $doc->child(0)->child(0)->child(0), 'PPI::Statement' ); isa_ok( $doc->child(0)->child(0)->child(0), 'PPI::Statement::Expression' ); } ##################################################################### # Bug 19629: End of list mistakenly seen as end of statement SCOPE: { my $doc = safe_new \'()'; isa_ok( $doc->child(0), 'PPI::Statement' ); } SCOPE: { my $doc = safe_new \'{}'; isa_ok( $doc->child(0), 'PPI::Statement' ); } SCOPE: { my $doc = safe_new \'[]'; isa_ok( $doc->child(0), 'PPI::Statement' ); } ##################################################################### # Bug 21575: PPI::Statement::Variable::variables breaks for lists # with leading whitespace SCOPE: { my $doc = safe_new \'my ( $self, $param ) = @_;'; my $stmt = $doc->child(0); isa_ok( $stmt, 'PPI::Statement::Variable' ); is_deeply( [$stmt->variables], ['$self', '$param'], 'variables() for my list with whitespace' ); } ##################################################################### # Bug #23788: PPI::Statement::location() returns undef for C<({})>. SCOPE: { my $doc = safe_new \'({})'; my $bad = $doc->find( sub { not defined $_[1]->location } ); is( $bad, '', 'All elements return defined for ->location' ); } ##################################################################### # Chris Laco on users@perlcritic.tigris.org (sorry no direct URL...) # http://perlcritic.tigris.org/servlets/SummarizeList?listName=users # Empty constructor has no location SCOPE: { my $doc = safe_new \'$h={};'; my $hash = $doc->find('PPI::Structure::Constructor')->[0]; ok($hash, 'location for empty constructor - fetched a constructor'); is_deeply( $hash->location, [1,4,4,1,undef], 'location for empty constructor'); } ##################################################################### # Perl::MinimumVersion regression SCOPE: { my $doc = safe_new \'use utf8;'; my $stmt = $doc->child(0); isa_ok( $stmt, 'PPI::Statement::Include' ); is( $stmt->pragma, 'utf8', 'pragma() with numbers' ); } ##################################################################### # Proof that _new_token must return "1" SCOPE: { my $doc = safe_new \<<'END_PERL'; $$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs; END_PERL } ###################################################################### # Check quoteengine token behaviour at end of file SCOPE: { my $doc = safe_new \'s/'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 0, 'Found 0 section' ); } SCOPE: { my $doc = safe_new \'s{'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 0, 'Found 0 section' ); } SCOPE: { my $doc = safe_new \'s/foo'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); is( $regexp->_section_content(0), 'foo', 's/foo correct at EOL' ); } SCOPE: { my $doc = safe_new \'s{foo'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); is( $regexp->_section_content(0), 'foo', 's{foo correct at EOL' ); } SCOPE: { my $doc = safe_new \'s/foo/'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); } SCOPE: { my $doc = safe_new \'s{foo}{'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); } SCOPE: { my $doc = safe_new \'s{foo}/'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); } SCOPE: { my $doc = safe_new \'s/foo/bar'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 2, 'Found 2 sections' ); is( $regexp->_section_content(1), 'bar', 's/foo/bar correct at EOL' ); } SCOPE: { my $doc = safe_new \'s{foo}{bar'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 2, 'Found 2 sections' ); is( $regexp->_section_content(1), 'bar', 's{foo}{bar correct at EOL' ); } SCOPE: { my $doc = safe_new \'s{foo}/bar'; my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 2, 'Found 2 sections' ); is( $regexp->_section_content(1), 'bar', 's{foo}/bar correct at EOL' ); } ###################################################################### # Confirmation of cases where we special case / to a regex SCOPE: { my $doc = safe_new \<<'END_PERL'; @foo = split /foo/, $var; return / Special /x ? 0 : 1; print "Hello" if /regex/; END_PERL my $match = $doc->find('PPI::Token::Regexp::Match'); is( scalar(@$match), 3, 'Found expected number of matches' ); } PPI-1.278/t/ppi_statement_sub.t0000644000175000017500000002132014573465137015001 0ustar olafolaf#!/usr/bin/perl # Test PPI::Statement::Sub use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 1297 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Singletons qw( %KEYWORDS ); use Helper 'safe_new'; NAME: { for my $test ( { code => 'sub foo {}', name => 'foo' }, { code => 'sub foo{}', name => 'foo' }, { code => 'sub FOO {}', name => 'FOO' }, { code => 'sub _foo {}', name => '_foo' }, { code => 'sub _0foo {}', name => '_0foo' }, { code => 'sub _foo0 {}', name => '_foo0' }, { code => 'sub ___ {}', name => '___' }, { code => 'sub bar() {}', name => 'bar' }, { code => 'sub baz : method{}', name => 'baz' }, { code => 'sub baz : method lvalue{}', name => 'baz' }, { code => 'sub baz : method:lvalue{}', name => 'baz' }, { code => 'sub baz (*) : method : lvalue{}', name => 'baz' }, { code => 'sub x64 {}', name => 'x64' }, # should not be parsed as x operator ) { my $code = $test->{code}; my $name = $test->{name}; subtest "'$code'", => sub { my $Document = safe_new \$code; my ( $sub_statement, $dummy ) = $Document->schildren; isa_ok( $sub_statement, 'PPI::Statement::Sub', "document child" ); is( $dummy, undef, "document has exactly one child" ); is( eval { $sub_statement->name }, $name, "name() correct" ); }; } } LEXSUB: { for my $test ( { code => 'sub foo {}', type => undef }, { code => 'my sub foo {}', type => 'my' }, { code => 'our sub foo {}', type => 'our' }, { code => 'state sub foo {}', type => 'state' }, { code => 'my sub foo ($) {}', type => 'my' }, ) { my $code = $test->{code}; my $type = $test->{type}; my $Document = safe_new \$code; my ( $sub_statement, $dummy ) = $Document->schildren(); isa_ok( $sub_statement, 'PPI::Statement::Sub', "$code: document child is a sub" ); is( $dummy, undef, "$code: document has exactly one child" ); is( $sub_statement->type, $type, "$code: type matches" ); is( $sub_statement->name, 'foo', "$code: name matches" ); } } SUB_WORD_OPTIONAL: { # 'sub' is optional for these special subs. Make sure they're # recognized as subs and sub declarations. for my $name ( qw( AUTOLOAD DESTROY ) ) { for my $sub ( '', 'sub ' ) { # '{}' -- function definition # ';' -- function declaration # '' -- function declaration with missing semicolon for my $followed_by ( ' {}', '{}', ';', '' ) { test_sub_as( $sub, $name, $followed_by ); } } } # Through 1.218, the PPI statement AUTOLOAD and DESTROY would # gobble up everything after them until it hit an explicit # statement terminator. Make sure statements following them are # not gobbled. my $desc = 'regression: word+block not gobbling to statement terminator'; for my $word ( qw( AUTOLOAD DESTROY ) ) { my $Document = safe_new \"$word {} sub foo {}"; my $statements = $Document->find('Statement::Sub') || []; is( scalar(@$statements), 2, "$desc for $word + sub" ); $Document = safe_new \"$word {} package;"; $statements = $Document->find('Statement::Sub') || []; is( scalar(@$statements), 1, "$desc for $word + package" ); $statements = $Document->find('Statement::Package') || []; is( scalar(@$statements), 1, "$desc for $word + package" ); } } PROTOTYPE: { # Doesn't have to be as thorough as ppi_token_prototype.t, since # we're just making sure PPI::Token::Prototype->prototype gets # passed through correctly. for my $test ( [ '', undef ], [ '()', '' ], [ '( $*Z@ )', '$*Z@' ], ) { my ( $proto_text, $expected ) = @$test; my $Document = safe_new \"sub foo $proto_text {}"; my ( $sub_statement, $dummy ) = $Document->schildren(); isa_ok( $sub_statement, 'PPI::Statement::Sub', "$proto_text document child is a sub" ); is( $dummy, undef, "$proto_text document has exactly one child" ); is( $sub_statement->prototype, $expected, "$proto_text: prototype matches" ); } } PROTOTYPE_LEXSUB: { # Doesn't have to be as thorough as ppi_token_prototype.t, since # we're just making sure PPI::Token::Prototype->prototype gets # passed through correctly. for my $test ( [ '', undef ], [ '()', '' ], [ '( $*Z@ )', '$*Z@' ], ) { my ( $proto_text, $expected ) = @$test; my $Document = safe_new \"my sub foo $proto_text {}"; my ( $sub_statement, $dummy ) = $Document->schildren(); isa_ok( $sub_statement, 'PPI::Statement::Sub', "$proto_text document child is a sub" ); is( $dummy, undef, "$proto_text document has exactly one child" ); is( $sub_statement->prototype, $expected, "$proto_text: prototype matches" ); } } BLOCK_AND_FORWARD: { for my $test ( { code => 'sub foo {1;}', block => '{1;}' }, { code => 'sub foo{2;};', block => '{2;}' }, { code => "sub foo\n{3;};", block => '{3;}' }, { code => 'sub foo;', block => '' }, { code => 'sub foo', block => '' }, ) { my $code = $test->{code}; my $block = $test->{block}; my $Document = safe_new \$code; my ( $sub_statement, $dummy ) = $Document->schildren(); isa_ok( $sub_statement, 'PPI::Statement::Sub', "$code: document child is a sub" ); is( $dummy, undef, "$code: document has exactly one child" ); is( $sub_statement->block, $block, "$code: block matches" ); is( !$sub_statement->block, !!$sub_statement->forward, "$code: block and forward are opposites" ); } } RESERVED: { for my $test ( { code => 'sub BEGIN {}', reserved => 1 }, { code => 'sub CHECK {}', reserved => 1 }, { code => 'sub UNITCHECK {}', reserved => 1 }, { code => 'sub INIT {}', reserved => 1 }, { code => 'sub END {}', reserved => 1 }, { code => 'sub AUTOLOAD {}', reserved => 1 }, { code => 'sub CLONE_SKIP {}', reserved => 1 }, { code => 'sub __SUB__ {}', reserved => 1 }, { code => 'sub _FOO {}', reserved => 1 }, { code => 'sub FOO9 {}', reserved => 1 }, { code => 'sub FO9O {}', reserved => 1 }, { code => 'sub FOo {}', reserved => 0 }, ) { my $code = $test->{code}; my $reserved = $test->{reserved}; my $Document = safe_new \$code; my ( $sub_statement, $dummy ) = $Document->schildren(); isa_ok( $sub_statement, 'PPI::Statement::Sub', "$code: document child is a sub" ); is( $dummy, undef, "$code: document has exactly one child" ); is( !!$sub_statement->reserved, !!$reserved, "$code: reserved matches" ); } } sub test_sub_as { my ( $sub, $name, $followed_by ) = @_; my $code = "$sub$name$followed_by"; my $Document = safe_new \$code; my ( $sub_statement, $dummy ) = $Document->schildren; isa_ok( $sub_statement, 'PPI::Statement::Sub', "$code: document child is a sub" ); isnt( ref $sub_statement, 'PPI::Statement::Scheduled', "$code: not a PPI::Statement::Scheduled" ); is( $dummy, undef, "$code: document has exactly one child" ); ok( $sub_statement->reserved, "$code: is reserved" ); is( $sub_statement->name, $name, "$code: name() correct" ); if ( $followed_by =~ /}/ ) { isa_ok( $sub_statement->block, 'PPI::Structure::Block', "$code: has a block" ); } else { ok( !$sub_statement->block, "$code: has no block" ); } return; } KEYWORDS_AS_SUB_NAMES: { my @names = ( # normal name 'foo', # Keywords must parse as Word and not influence lexing # of subsequent curly braces. keys %KEYWORDS, # regression: misparsed as version string 'v10', # Other weird and/or special words, just in case '__PACKAGE__', '__FILE__', '__LINE__', '__SUB__', 'AUTOLOAD', ); my @blocks = ( [ ';', 'PPI::Token::Structure' ], [ ' ;', 'PPI::Token::Structure' ], [ '{ 1 }', 'PPI::Structure::Block' ], [ ' { 1 }', 'PPI::Structure::Block' ], ); $_->[2] = strip_ws_padding( $_->[0] ) for @blocks; for my $name ( @names ) { for my $block_pair ( @blocks ) { my @test = prepare_sub_test( $block_pair, $name ); test_subs( @test ); } } } sub strip_ws_padding { my ( $string ) = @_; $string =~ s/(^\s+|\s+$)//g; return $string; } sub prepare_sub_test { my ( $block_pair, $name ) = @_; my ( $block, $block_type, $block_stripped ) = @{$block_pair}; my $code = "sub $name $block"; my $expected_sub_tokens = [ [ 'PPI::Token::Word', 'sub' ], [ 'PPI::Token::Word', $name ], [ $block_type, $block_stripped ], ]; return ( $code, $expected_sub_tokens ); } sub test_subs { my ( $code, $expected_sub_tokens ) = @_; subtest "'$code'", => sub { my $Document = safe_new \"$code 999;"; is( $Document->schildren, 2, "number of statements in document" ); isa_ok( $Document->schild(0), 'PPI::Statement::Sub', "entire code" ); my $got_tokens = [ map { [ ref $_, "$_" ] } $Document->schild(0)->schildren ]; is_deeply( $got_tokens, $expected_sub_tokens, "$code tokens as expected" ); # second child not swallowed up by the first isa_ok( $Document->schild(1), 'PPI::Statement', "prior statement end recognized" ); isa_ok( eval { $Document->schild(1)->schild(0) }, 'PPI::Token::Number', "inner code" ); is( eval { $Document->schild(1)->schild(0) }, '999', "number correct" ); }; return; } PPI-1.278/t/18_cache.t0000644000175000017500000001151714573465137012636 0ustar olafolaf#!/usr/bin/perl # Test PPI::Cache use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 44 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catfile ); use File::Temp qw( tempdir ); use Scalar::Util qw( refaddr ); use PPI::Document (); use PPI::Cache (); use Test::SubCalls 1.07 (); use constant VMS => !! ( $^O eq 'VMS' ); use constant FILE => VMS ? 'File::Spec::Unix' : 'File::Spec'; use Helper 'safe_new'; my $this_file = FILE->catdir( 't', 'data', '03_document', 'test.dat' ); my $cache_dir = tempdir(CLEANUP => 1); ok( -d $cache_dir, 'Verified the cache path exists' ); ok( -w $cache_dir, 'Can write to the cache path' ); my $sample_document = \'print "Hello World!\n";'; ##################################################################### # Basic Testing # Create a basic cache object my $Cache = PPI::Cache->new( path => $cache_dir, ); isa_ok( $Cache, 'PPI::Cache' ); is( scalar($Cache->path), $cache_dir, '->path returns the original path' ); is( scalar($Cache->readonly), '', '->readonly returns false by default' ); # Create a test document my $doc = safe_new $sample_document; my $doc_md5 = '64568092e7faba16d99fa04706c46517'; is( $doc->hex_id, $doc_md5, '->hex_id specifically matches the UNIX newline md5' ); my $doc_file = catfile($cache_dir, '6', '64', '64568092e7faba16d99fa04706c46517.ppi'); my $bad_md5 = 'abcdef1234567890abcdef1234567890'; my $bad_file = catfile($cache_dir, 'a', 'ab', 'abcdef1234567890abcdef1234567890.ppi'); # Save to an arbitrary location ok( $Cache->_store($bad_md5, $doc), '->_store returns true' ); ok( -f $bad_file, 'Created file where expected' ); my $loaded = $Cache->_load($bad_md5); isa_ok( $loaded, 'PPI::Document' ); is_deeply( $doc, $loaded, '->_load loads the same document back in' ); # Store the test document in the cache in its proper place is( scalar( $Cache->store_document($doc) ), 1, '->store_document(Document) returns true' ); ok( -f $doc_file, 'The document was stored in the expected location' ); # Check the _md5hex method is( PPI::Cache->_md5hex($sample_document), $doc_md5, '->_md5hex returns as expected for sample document' ); is( PPI::Cache->_md5hex($doc_md5), $doc_md5, '->_md5hex null transform works as expected' ); is( $Cache->_md5hex($sample_document), $doc_md5, '->_md5hex returns as expected for sample document' ); is( $Cache->_md5hex($doc_md5), $doc_md5, '->_md5hex null transform works as expected' ); # Retrieve the Document by content $loaded = $Cache->get_document( $sample_document ); isa_ok( $loaded, 'PPI::Document' ); is_deeply( $doc, $loaded, '->get_document(\$source) loads the same document back in' ); # Retrieve the Document by md5 directly $loaded = $Cache->get_document( $doc_md5 ); isa_ok( $loaded, 'PPI::Document' ); is_deeply( $doc, $loaded, '->get_document($md5hex) loads the same document back in' ); ##################################################################### # Empiric Testing # Load a test document twice, and see how many tokenizer objects get # created internally. is( PPI::Document->get_cache, undef, 'PPI::Document cache initially undef' ); ok( PPI::Document->set_cache( $Cache ), 'PPI::Document->set_cache returned true' ); isa_ok( PPI::Document->get_cache, 'PPI::Cache' ); is( refaddr($Cache), refaddr(PPI::Document->get_cache), '->get_cache returns the same cache object' ); SCOPE: { # Set the tracking on the Tokenizer constructor ok( Test::SubCalls::sub_track( 'PPI::Tokenizer::new' ), 'Tracking calls to PPI::Tokenizer::new' ); Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 0 ); my $doc1 = safe_new $this_file; my $doc2 = safe_new $this_file; unless ( $doc1 and $doc2 ) { skip( "Skipping due to previous failures", 3 ); } Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 1, 'Two calls to PPI::Document->new results in one Tokenizer object creation' ); ok( refaddr($doc1) != refaddr($doc2), 'PPI::Document->new with cache enabled does NOT return the same object' ); is_deeply( $doc1, $doc2, 'PPI::Document->new with cache enabled returns two identical objects' ); } SCOPE: { # Done now, can we clear the cache? is( PPI::Document->set_cache(undef), 1, '->set_cache(undef) returns true' ); is( PPI::Document->get_cache, undef, '->get_cache returns undef' ); # Next, test the import mechanism is( eval "use PPI::Cache path => '$cache_dir'; 1", 1, 'use PPI::Cache path => ...; succeeded' ); isa_ok( PPI::Document->get_cache, 'PPI::Cache' ); is( scalar(PPI::Document->get_cache->path), $cache_dir, '->path returns the original path' ); is( scalar(PPI::Document->get_cache->readonly), '', '->readonly returns false by default' ); # Does it still keep the previously cached documents Test::SubCalls::sub_reset( 'PPI::Tokenizer::new' ); my $doc3 = safe_new $this_file; Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 0, 'Tokenizer was not created. Previous cache used ok' ); } 1; PPI-1.278/t/19_selftesting.t0000644000175000017500000001317314573465137014123 0ustar olafolaf#!/usr/bin/perl # Load ALL of the PPI files, and look for a collection # of known problems, implemented using PPI itself. # Using PPI to analyse its own code at install-time? Fuck yeah! :) use lib 't/lib'; use PPI::Test::pragmas; use Class::Inspector 1.22 (); use File::Spec::Functions qw( catdir ); use Params::Util qw( _CLASS _ARRAY _INSTANCE _IDENTIFIER ); use PPI (); use PPI::Test qw( find_files ); use PPI::Test::Object (); ## no perlimports use Test::More; # Plan comes later use Test::Object qw( object_ok ); use constant CI => Class::Inspector::; use Helper 'safe_new'; ##################################################################### # Prepare # Find all of the files to be checked my %tests = map { $_ => $INC{$_} } grep { ! /\bXS\.pm/ } grep { /^PPI\b/ } keys %INC; unless ( %tests ) { Test::More::plan( tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); ok( undef, "Failed to find any files to test" ); exit(); } my @files = sort values %tests; # Find all the testable perl files in t/data foreach my $dir ( '05_lexer', '08_regression', '11_util', '13_data', '15_transform' ) { my @perl = find_files( catdir('t', 'data', $dir) ); push @files, @perl; } # Declare our plan Test::More::plan( tests => scalar(@files) * 16 + 4 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); ##################################################################### # Self-test the search functions before we use them # Check this actually finds something bad my $sample = safe_new \<<'END_PERL'; isa($foo, 'Bad::Class1'); isa($foo, 'PPI::Document'); $foo->isa('Bad::Class2'); $foo->isa("Bad::Class3"); isa($foo, 'ARRAY'); # Not bad isa($foo->thing, qq # ok? ); END_PERL my $bad = $sample->find( \&bug_bad_isa_class_name ); ok( _ARRAY($bad), 'Found bad things' ); @$bad = map { $_->string } @$bad; is_deeply( $bad, [ 'Bad::Class1', 'Bad::Class2', 'Bad::Class3', 'Bad::Class4' ], 'Found all found known bad things' ); ##################################################################### # Run the Tests foreach my $file ( @files ) { # MD5 the raw file my $md5a = PPI::Util::md5hex_file($file); like( $md5a, qr/^[[:xdigit:]]{32}\z/, 'md5hex_file ok' ); # Load the file my $Document = safe_new $file; ok( _INSTANCE($Document, 'PPI::Document'), "$file: Parsed ok" ); # Compare the preload signature to the post-load value my $md5b = $Document->hex_id; is( $md5b, $md5a, '->hex_id matches md5hex' ); # By this point, everything should have parsed properly at least # once, so no need to skip. SCOPE: { my $rv = $Document->find( \&bug_bad_isa_class_name ); if ( $rv ) { $Document->index_locations; foreach ( @$rv ) { print "# $file: Found bad class " . $_->content . "\n"; } } is_deeply( $rv, '', "$file: All class names in ->isa calls exist" ); } SCOPE: { my $rv = $Document->find( \&bad_static_method ); if ( $rv ) { $Document->index_locations; foreach ( @$rv ) { my $c = $_->sprevious_sibling->content; my $m = $_->snext_sibling->content; my $l = $_->location; print "# $file: Found bad call ${c}->${m} at line $l->[0], col $l->[1]\n"; } } is_deeply( $rv, '', "$file: All class names in static method calls" ); } # Test with Test::Object stuff object_ok( $Document ); } ##################################################################### # Test Functions # Check for accidental use of illegal or non-existant classes in # ->isa calls. This has happened at least once, presumably because # PPI has a LOT of classes and it can get confusing. sub bug_bad_isa_class_name { my ($Document, $Element) = @_; # Find a quote containing a class name $Element->isa('PPI::Token::Quote') or return ''; _CLASS($Element->string) or return ''; if ( $Element->string =~ /^(?:ARRAY|HASH|CODE|SCALAR|REF|GLOB)$/ ) { return ''; } # It should be the last thing in an expression in a list my $Expression = $Element->parent or return ''; $Expression->isa('PPI::Statement::Expression') or return ''; $Element == $Expression->schild(-1) or return ''; my $List = $Expression->parent or return ''; $List->isa('PPI::Structure::List') or return ''; $List->schildren == 1 or return ''; # The list should be the params list for an isa call my $Word = $List->sprevious_sibling or return ''; $Word->isa('PPI::Token::Word') or return ''; $Word->content =~ /^(?:UNIVERSAL::)?isa\z/s or return ''; # Is the class real and loaded? CI->loaded($Element->string) and return ''; # Looks like we found a class that doesn't exist in # an isa call. return 1; } # Check for the use of a method that doesn't exist sub bad_static_method { my ($document, $element) = @_; # Find a quote containing a class name $element->isa('PPI::Token::Operator') or return ''; $element->content eq '->' or return ''; # Check the method my $method = $element->snext_sibling or return ''; $method->isa('PPI::Token::Word') or return ''; _IDENTIFIER($method->content) or return ''; # Check the class my $class = $element->sprevious_sibling or return ''; $class->isa('PPI::Token::Word') or return ''; _CLASS($class->content) or return ''; # It's usually a deep class $class = $class->content; $method = $method->content; $class =~ /::/ or return ''; # Check the method exists $class->can($method) and return ''; # special case IO::String as it will normally not be loaded, and the call # to it is also conditional. $class eq 'IO::String' && $method eq 'new' and return ''; return 1; } 1; PPI-1.278/t/11_util.t0000644000175000017500000000264014573465137012536 0ustar olafolaf#!/usr/bin/perl # Test the PPI::Util package use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 11 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catfile ); use PPI (); use PPI::Util qw( _Document _slurp ); use Helper 'safe_new'; # Execute the tests my $testfile = catfile( 't', 'data', '11_util', 'test.pm' ); my $testsource = 'print "Hello World!\n"'; my $slurpfile = catfile( 't', 'data', 'basic.pl' ); my $slurpcode = <<'END_FILE'; #!/usr/bin/perl if ( 1 ) { print "Hello World!\n"; } 1; END_FILE ##################################################################### # Test PPI::Util::_Document my $Document = safe_new \$testsource; # Good things foreach my $thing ( $testfile, \$testsource, $Document, [] ) { isa_ok( _Document( $thing ), 'PPI::Document' ); } # Bad things ### erm... # Evil things foreach my $thing ( {}, sub () { 1 } ) { is( _Document( $thing ), undef, '_Document(evil) returns undef' ); } ##################################################################### # Test PPI::Util::_slurp my $source = _slurp( $slurpfile ); is_deeply( $source, \$slurpcode, '_slurp loads file as expected' ); ##################################################################### # Check the capability flags my $have_unicode = PPI::Util::HAVE_UNICODE(); ok( defined $have_unicode, 'HAVE_UNICODE defined' ); is( $have_unicode, !! $have_unicode, 'HAVE_UNICODE is a boolean' ); PPI-1.278/t/ppi_statement_include.t0000644000175000017500000002506414573465137015644 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Statement::Include use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 6070 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Singletons qw( %KEYWORDS ); use Helper 'safe_new'; TYPE: { my $document = safe_new \<<'END_PERL'; require 5.6; require Module; require 'Module.pm'; use 5.6; use Module; use Module 1.00; no Module; END_PERL my $statements = $document->find('PPI::Statement::Include'); is( scalar(@$statements), 7, 'Found 7 include statements' ); my @expected = qw{ require require require use use use no }; foreach ( 0 .. 6 ) { is( $statements->[$_]->type, $expected[$_], "->type $_ ok" ); } } MODULE_VERSION: { my $document = safe_new \<<'END_PERL'; use Integer::Version 1; use Float::Version 1.5; use Version::With::Argument 1 2; use No::Version; use No::Version::With::Argument 'x'; use No::Version::With::Arguments 1, 2; use 5.005; use VString::Version v10; use VString::Version::Decimal v1.5; END_PERL my $statements = $document->find('PPI::Statement::Include'); is( scalar @{$statements}, 9, 'Found expected include statements.' ); is( $statements->[0]->module_version, 1, 'Integer version' ); is( $statements->[1]->module_version, 1.5, 'Float version' ); is( $statements->[2]->module_version, 1, 'Version and argument' ); is( $statements->[3]->module_version, undef, 'No version, no arguments' ); is( $statements->[4]->module_version, undef, 'No version, with argument' ); is( $statements->[5]->module_version, undef, 'No version, with arguments' ); is( $statements->[6]->module_version, undef, 'Version include, no module' ); is( $statements->[7]->module_version, 'v10', 'Version string' ); is( $statements->[8]->module_version, 'v1.5', 'Version string with decimal' ); } VERSION: { my $document = safe_new \<<'END_PERL'; # Examples from perlfunc in 5.10. use v5.6.1; use 5.6.1; use 5.006_001; use 5.006; use 5.6.1; # Same, but using require. require v5.6.1; require 5.6.1; require 5.006_001; require 5.006; require 5.6.1; # Module. use Float::Version 1.5; END_PERL my $statements = $document->find('PPI::Statement::Include'); is( scalar @{$statements}, 11, 'Found expected include statements.' ); is( $statements->[0]->version, 'v5.6.1', 'use v-string' ); is( $statements->[1]->version, '5.6.1', 'use v-string, no leading "v"' ); is( $statements->[2]->version, '5.006_001', 'use developer release' ); is( $statements->[3]->version, '5.006', 'use back-compatible version, followed by...' ); is( $statements->[4]->version, '5.6.1', '... use v-string, no leading "v"' ); is( $statements->[5]->version, 'v5.6.1', 'require v-string' ); is( $statements->[6]->version, '5.6.1', 'require v-string, no leading "v"' ); is( $statements->[7]->version, '5.006_001', 'require developer release' ); is( $statements->[8]->version, '5.006', 'require back-compatible version, followed by...' ); is( $statements->[9]->version, '5.6.1', '... require v-string, no leading "v"' ); is( $statements->[10]->version, '', 'use module version' ); } VERSION_LITERAL: { my $document = safe_new \<<'END_PERL'; # Examples from perlfunc in 5.10. use v5.6.1; use 5.6.1; use 5.006_001; use 5.006; use 5.6.1; # Same, but using require. require v5.6.1; require 5.6.1; require 5.006_001; require 5.006; require 5.6.1; # Module. use Float::Version 1.5; END_PERL my $statements = $document->find('PPI::Statement::Include'); is( scalar @{$statements}, 11, 'Found expected include statements.' ); is( $statements->[0]->version_literal, v5.6.1, 'use v-string' ); is( $statements->[1]->version_literal, 5.6.1, 'use v-string, no leading "v"' ); is( $statements->[2]->version_literal, 5.006_001, 'use developer release' ); is( $statements->[3]->version_literal, 5.006, 'use back-compatible version, followed by...' ); is( $statements->[4]->version_literal, 5.6.1, '... use v-string, no leading "v"' ); is( $statements->[5]->version_literal, v5.6.1, 'require v-string' ); is( $statements->[6]->version_literal, 5.6.1, 'require v-string, no leading "v"' ); is( $statements->[7]->version_literal, 5.006_001, 'require developer release' ); is( $statements->[8]->version_literal, 5.006, 'require back-compatible version, followed by...' ); is( $statements->[9]->version_literal, 5.6.1, '... require v-string, no leading "v"' ); is( $statements->[10]->version_literal, '', 'use module version' ); } ARGUMENTS: { my $document = safe_new \<<'END_PERL'; use 5.006; # Don't expect anything. use Foo; # Don't expect anything. use Foo 5; # Don't expect anything. use Foo 'bar'; # One thing. use Foo 5 'bar'; # One thing. use Foo qw< bar >, "baz"; use Test::More tests => 5 * 9 # Don't get tripped up by the lack of the ";" END_PERL my $statements = $document->find('PPI::Statement::Include'); is( scalar @{$statements}, 7, 'Found expected include statements.' ); is( scalar $statements->[0]->arguments, undef, 'arguments for perl version', ); is( scalar $statements->[1]->arguments, undef, 'arguments with no arguments', ); is( scalar $statements->[2]->arguments, undef, 'arguments with no arguments but module version', ); my @arguments = $statements->[3]->arguments; is( scalar @arguments, 1, 'arguments with single argument' ); is( $arguments[0]->content, q<'bar'>, 'arguments with single argument' ); @arguments = $statements->[4]->arguments; is( scalar @arguments, 1, 'arguments with single argument and module version', ); is( $arguments[0]->content, q<'bar'>, 'arguments with single argument and module version', ); @arguments = $statements->[5]->arguments; is( scalar @arguments, 3, 'arguments with multiple arguments', ); is( $arguments[0]->content, q/qw< bar >/, 'arguments with multiple arguments', ); is( $arguments[1]->content, q<,>, 'arguments with multiple arguments', ); is( $arguments[2]->content, q<"baz">, 'arguments with multiple arguments', ); @arguments = $statements->[6]->arguments; is( scalar @arguments, 5, 'arguments with Test::More', ); is( $arguments[0]->content, 'tests', 'arguments with Test::More', ); is( $arguments[1]->content, q[=>], 'arguments with Test::More', ); is( $arguments[2]->content, 5, 'arguments with Test::More', ); is( $arguments[3]->content, '*', 'arguments with Test::More', ); is( $arguments[4]->content, 9, 'arguments with Test::More', ); } KEYWORDS_AS_MODULE_NAMES: { my %known_bad = map { $_ => 1 } 'no m 1.2.3;', 'no m ;', 'no m v1.2.3;', 'no m v10;', 'no q 1.2.3;', 'no q ;', 'no q v1.2.3;', 'no q v10;', 'no qq 1.2.3;', 'no qq ;', 'no qq v1.2.3;', 'no qq v10;', 'no qr 1.2.3;', 'no qr ;', 'no qr v1.2.3;', 'no qr v10;', 'no qw 1.2.3;', 'no qw ;', 'no qw v1.2.3;', 'no qw v10;', 'no qx 1.2.3;', 'no qx ;', 'no qx v1.2.3;', 'no qx v10;', 'no s 1.2.3;', 'no s ;', 'no s v1.2.3;', 'no s v10;', 'no tr 1.2.3;', 'no tr ;', 'no tr v1.2.3;', 'no tr v10;', 'no y 1.2.3;', 'no y ;', 'no y v1.2.3;', 'no y v10;', 'use m 1.2.3;', 'use m ;', 'use m v1.2.3;', 'use m v10;', 'use q 1.2.3;', 'use q ;', 'use q v1.2.3;', 'use q v10;', 'use qq 1.2.3;', 'use qq ;', 'use qq v1.2.3;', 'use qq v10;', 'use qr 1.2.3;', 'use qr ;', 'use qr v1.2.3;', 'use qr v10;', 'use qw 1.2.3;', 'use qw ;', 'use qw v1.2.3;', 'use qw v10;', 'use qx 1.2.3;', 'use qx ;', 'use qx v1.2.3;', 'use qx v10;', 'use s 1.2.3;', 'use s ;', 'use s v1.2.3;', 'use s v10;', 'use tr 1.2.3;', 'use tr ;', 'use tr v1.2.3;', 'use tr v10;', 'use y 1.2.3;', 'use y ;', 'use y v1.2.3;', 'use y v10;'; my %known_badish = map { $_ => 1 } 'use not ;', 'use lt ;', 'no and 1.2.3;', 'no and ;', 'no and v1.2.3;', 'no and v10;', 'no cmp 1.2.3;', 'no cmp ;', 'no cmp v1.2.3;', 'no cmp v10;', 'no eq 1.2.3;', 'no eq ;', 'no eq v1.2.3;', 'no eq v10;', 'no ge 1.2.3;', 'no ge ;', 'no ge v1.2.3;', 'no ge v10;', 'no gt 1.2.3;', 'no gt ;', 'no gt v1.2.3;', 'no gt v10;', 'no le 1.2.3;', 'no le ;', 'no le v1.2.3;', 'no le v10;', 'no lt 1.2.3;', 'no lt ;', 'no lt v1.2.3;', 'no lt v10;', 'no ne 1.2.3;', 'no ne ;', 'no ne v1.2.3;', 'no ne v10;', 'no not 1.2.3;', 'no not ;', 'no not v1.2.3;', 'no not v10;', 'no or 1.2.3;', 'no or ;', 'no or v1.2.3;', 'no or v10;', 'no x 1.2.3;', 'no x ;', 'no x v1.2.3;', 'no x v10;', 'no xor 1.2.3;', 'no xor ;', 'no xor v1.2.3;', 'no xor v10;', 'use and 1.2.3;', 'use and ;', 'use and v1.2.3;', 'use and v10;', 'use cmp 1.2.3;', 'use cmp ;', 'use cmp v1.2.3;', 'use cmp v10;', 'use eq 1.2.3;', 'use eq ;', 'use eq v1.2.3;', 'use eq v10;', 'use ge 1.2.3;', 'use ge ;', 'use ge v1.2.3;', 'use ge v10;', 'use gt 1.2.3;', 'use gt ;', 'use gt v1.2.3;', 'use gt v10;', 'use le 1.2.3;', 'use le ;', 'use le v1.2.3;', 'use le v10;', 'use lt 1.2.3;', 'use lt v1.2.3;', 'use lt v10;', 'use ne 1.2.3;', 'use ne ;', 'use ne v1.2.3;', 'use ne v10;', 'use not 1.2.3;', 'use not v1.2.3;', 'use not v10;', 'use or 1.2.3;', 'use or ;', 'use or v1.2.3;', 'use or v10;', 'use x 1.2.3;', 'use x ;', 'use x v1.2.3;', 'use x v10;', 'use xor 1.2.3;', 'use xor ;', 'use xor v1.2.3;', 'use xor v10;'; for my $name ( # normal names 'Foo', 'Foo::Bar', 'Foo::Bar::Baz', 'version', # Keywords must parse as Word and not influence lexing # of subsequent curly braces. keys %KEYWORDS, # Other weird and/or special words, just in case '__PACKAGE__', '__FILE__', '__LINE__', '__SUB__', 'AUTOLOAD', ) { for my $include ( 'use', 'no' ) { # 'require' does not force tokes to be words for my $version ( '', 'v1.2.3', '1.2.3', 'v10' ) { my $code = "$include $name $version;"; my $Document = safe_new \"$code 999;"; subtest "'$code'", => sub { { local $TODO = $known_bad{$code} ? "known bug" : undef; is( $Document->schildren(), 2, "$code number of statements in document" ); } isa_ok( $Document->schild(0), 'PPI::Statement::Include', $code ); { local $TODO = ($known_bad{$code}||$known_badish{$code}) ? "known bug" : undef; # first child is the include statement my $expected_tokens = [ [ 'PPI::Token::Word', $include ], [ 'PPI::Token::Word', $name ], ]; if ( $version ) { push @$expected_tokens, [ 'PPI::Token::Number::Version', $version ]; } push @$expected_tokens, [ 'PPI::Token::Structure', ';' ]; my $got_tokens = [ map { [ ref $_, "$_" ] } $Document->schild(0)->schildren() ]; is_deeply( $got_tokens, $expected_tokens, "$code tokens as expected" ); } { local $TODO = $known_bad{$code} ? "known bug" : undef; # second child not swallowed up by the first isa_ok( $Document->schild(1), 'PPI::Statement', "$code prior statement end recognized" ); isa_ok( eval { $Document->schild(1)->schild(0) }, 'PPI::Token::Number', $code ); is( eval { $Document->schild(1)->schild(0) }, '999', "$code number correct" ); } }; } } } } PPI-1.278/t/24_v6.t0000644000175000017500000000131614573465137012117 0ustar olafolaf#!/usr/bin/perl # Regression test of a Perl 5 grammar that exploded # with a "98 subroutine recursion" error in 1.201 use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 10 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catfile ); use PPI (); use Helper 'safe_new'; foreach my $file ( qw{ Simple.pm Grammar.pm } ) { my $path = catfile( qw{ t data 24_v6 }, $file ); ok( -f $path, "Found test file $file" ); my $doc = safe_new $path; # Find the first Perl6 include my $include = $doc->find_first( 'PPI::Statement::Include::Perl6' ); isa_ok( $include, 'PPI::Statement::Include::Perl6' ); ok( scalar($include->perl6), 'use v6 statement has a working ->perl6 method', ); } PPI-1.278/t/07_token.t0000644000175000017500000001764114573465137012715 0ustar olafolaf#!/usr/bin/perl # Formal unit tests for specific PPI::Token classes sub warns_on_misplaced_underscore { $] >= 5.006 and $] < 5.008 } sub dies_on_incomplete_bx { $] >= 5.031002 } use if !(-e 'META.yml'), "Test::InDistDir"; use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 594 + (warns_on_misplaced_underscore() ? 2 : 0 ) + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catdir ); use PPI (); use PPI::Test::Run (); ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir( catdir( 't', 'data', '07_token' ) ); ##################################################################### # PPI::Token::Number Unit Tests SCOPE: { my @examples = ( # code => base | '10f' | '10e' '0' => 10, '1' => 10, '10' => 10, '1_0' => 10, '.0' => '10f', '.0_0' => '10f', '-.0' => '10f', '0.' => '10f', '0.0' => '10f', '0.0_0' => '10f', '1_0.' => '10f', '.0e0' => '10e', '-.0e0' => '10e', '0.e1' => '10e', '0.0e-1' => '10e', '0.0e+1' => '10e', '0.0e-10' => '10e', '0.0e+10' => '10e', '0.0e100' => '10e', '1_0e1_0' => '10e', '1e00' => '10e', '1e+00' => '10e', '1e-00' => '10e', '1e00000' => '10e', '0b' => 2, '0b0' => 2, '0b10' => 2, '0b1_0' => 2, '00' => 8, '01' => 8, '010' => 8, '01_0' => 8, '0x' => 16, '0x0' => 16, '0x10' => 16, '0x1_0' => 16, '0.0.0' => 256, '.0.0' => 256, '127.0.0.1' => 256, '1.1.1.1.1.1' => 256, ); while ( @examples ) { my $code = shift @examples; my $base = shift @examples; if ( warns_on_misplaced_underscore() and ($code eq '1_0e1_0' or $code eq '1_0' or $code eq '1_0.') ) { SKIP: { skip( 'Ignoring known-bad cases on Perl 5.6.2', 5 ); } next; } my $is_exp = $base =~ s/e//; my $is_float = $is_exp || $base =~ s/f//; my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; is("$token", $code, "'$code' is a single token"); is($token->base, $base, "base of '$code' is $base"); is($token->isa('PPI::Token::Number::Float'), $is_float, "'$code' ".($is_float ? "is" : "not")." ::Float"); is($token->isa('PPI::Token::Number::Exp'), $is_exp, "'$code' ".($is_float ? "is" : "not")." ::Exp"); next if $base == 256; $^W = 0; my $underscore_incompatible = warns_on_misplaced_underscore() && $code =~ /^1_0[.]?$/; my $incomplete_incompatible = dies_on_incomplete_bx() && $code =~ /^0[bx]$/; my $literal = eval $code; my $err = $@; $literal = undef if $underscore_incompatible || $incomplete_incompatible; warning_is { $literal = eval $code } "Misplaced _ in number", "$] warns about misplaced underscore" if $underscore_incompatible; like($err, qr/No digits found for (binary|hexadecimal) literal/, "$] dies on incomplete binary/hexadecimal literals") if $underscore_incompatible; no warnings qw{ uninitialized }; cmp_ok($token->literal, '==', $err ? undef : $literal, "literal('$code'), eval error: " . ($err || "none")); } } for my $code ( '1.0._0' ) { my $token = PPI::Tokenizer->new( \$code )->get_token; isnt("$token", $code, 'tokenize bad version'); } for my $code ( '1.0.0.0_0' ) { my $token = PPI::Tokenizer->new( \$code )->get_token; is("$token", $code, 'tokenize good version'); } foreach my $code ( '08', '09', '0778', '0779' ) { my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; isa_ok($token, 'PPI::Token::Number::Octal'); is("$token", $code, "tokenize bad octal '$code'"); ok($token->{_error} && $token->{_error} =~ m/octal/i, 'invalid octal number should trigger parse error'); is($token->literal, undef, "literal('$code') is undef"); } BINARY: { my @tests = ( # Good binary numbers { code => '0b0', error => 0, value => 0 }, { code => '0b1', error => 0, value => 1 }, { code => '0B1', error => 0, value => 1 }, { code => '0b101', error => 0, value => 5 }, { code => '0b1_1', error => 0, value => 3 }, { code => '0b1__1', error => 0, value => 3 }, # perl warns, but parses it { code => '0b1__1_', error => 0, value => 3 }, # perl warns, but parses it # Bad binary numbers { code => '0b2', error => 1, value => 0 }, { code => '0B2', error => 1, value => 0 }, { code => '0b012', error => 1, value => 0 }, { code => '0B012', error => 1, value => 0 }, { code => '0B0121', error => 1, value => 0 }, ); foreach my $test ( @tests ) { my $code = $test->{code}; my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; isa_ok($token, 'PPI::Token::Number::Binary'); if ( $test->{error} ) { ok($token->{_error} && $token->{_error} =~ m/binary/i, 'invalid binary number should trigger parse error'); is($token->literal, undef, "literal('$code') is undef"); } else { ok(!$token->{_error}, "no error for '$code'"); is($token->literal, $test->{value}, "literal('$code') is $test->{value}"); } is($token->content, $code, "parsed everything"); } } HEX: { my @tests = ( # Good hex numbers--entire thing goes in the token { code => '0x0', parsed => '0x0', value => 0 }, { code => '0X1', parsed => '0X1', value => 1 }, { code => '0x1', parsed => '0x1', value => 1 }, { code => '0x_1', parsed => '0x_1', value => 1 }, { code => '0x__1', parsed => '0x__1', value => 1 }, # perl warns, but parses it { code => '0x__1_', parsed => '0x__1_', value => 1 }, # perl warns, but parses it { code => '0X1', parsed => '0X1', value => 1 }, { code => '0xc', parsed => '0xc', value => 12 }, { code => '0Xc', parsed => '0Xc', value => 12 }, { code => '0XC', parsed => '0XC', value => 12 }, { code => '0xbeef', parsed => '0xbeef', value => 48879 }, { code => '0XbeEf', parsed => '0XbeEf', value => 48879 }, { code => '0x0e', parsed => '0x0e', value => 14 }, { code => '0x00000e', parsed => '0x00000e', value => 14 }, { code => '0x000_00e', parsed => '0x000_00e', value => 14 }, { code => '0x000__00e', parsed => '0x000__00e', value => 14 }, # perl warns, but parses it # Bad hex numbers--tokenizing stops when bad digit seen { code => '0x', parsed => '0x', value => 0 }, { code => '0X', parsed => '0X', value => 0 }, { code => '0xg', parsed => '0x', value => 0 }, { code => '0Xg', parsed => '0X', value => 0 }, { code => '0XG', parsed => '0X', value => 0 }, { code => '0x0g', parsed => '0x0', value => 0 }, { code => '0X0g', parsed => '0X0', value => 0 }, { code => '0X0G', parsed => '0X0', value => 0 }, { code => '0x1g', parsed => '0x1', value => 1 }, { code => '0x1g2', parsed => '0x1', value => 1 }, { code => '0x1_g', parsed => '0x1_', value => 1 }, ); foreach my $test ( @tests ) { my $code = $test->{code}; my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; isa_ok($token, 'PPI::Token::Number::Hex'); ok(!$token->{_error}, "no error for '$code' even on invalid digits"); is($token->content, $test->{parsed}, "correctly parsed everything expected"); is($token->literal, $test->{value}, "literal('$code') is $test->{value}"); } } OCTAL: { my @tests = ( { code => '0o10', parsed => '0o10', value => 8 }, { code => '0O10', parsed => '0O10', value => 8 }, ); foreach my $test ( @tests ) { my $code = $test->{code}; my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; isa_ok($token, 'PPI::Token::Number::Octal'); is($token->content, $test->{parsed}, "correctly parsed everything expected"); is($token->literal, $test->{value}, "literal('$code') is $test->{value}"); } } PPI-1.278/t/ppi_token.t0000644000175000017500000000071114573465137013245 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 5 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); MODIFICATION: { my $one = PPI::Token->new( "" ); is $one->length, 0, "empty token has no length"; ok $one->add_content( "abcde" ), "can add strings"; is $one->length, 5, "adding actually adds"; ok $one->set_content( "abc" ), "can set content"; is $one->length, 3, "setting overwrites"; } PPI-1.278/t/ppi_token_quote.t0000644000175000017500000000123414573465137014463 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Quote use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 16 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; STRING: { # Prove what we say in the ->string docs my $Document = safe_new \<<'END_PERL'; 'foo' "foo" q{foo} qq END_PERL my $quotes = $Document->find('Token::Quote'); is( ref($quotes), 'ARRAY', 'Found quotes' ); is( scalar(@$quotes), 4, 'Found 4 quotes' ); foreach my $Quote ( @$quotes ) { isa_ok( $Quote, 'PPI::Token::Quote'); can_ok( $Quote, 'string' ); is( $Quote->string, 'foo', '->string returns "foo" for ' . $Quote->content ); } } PPI-1.278/t/16_xml.t0000644000175000017500000000177114573465137012372 0ustar olafolaf#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use PPI::Document (); use Test::More 0.86 tests => 16 + ($ENV{AUTHOR_TESTING} ? 1 : 0); ##################################################################### # Begin Tests my $code = 'print "Hello World";'; my $document = new_ok( PPI::Document:: => [ \$code ] ); my @elements = $document->elements; push @elements, $elements[0]->elements; my @expected = ( [ 'statement', {}, '' ], [ 'token_word', {}, 'print' ], [ 'token_whitespace', {}, ' ' ], [ 'token_quote_double', {}, '"Hello World"' ], [ 'token_structure', {}, ';' ], ); my $i = 0; foreach my $expect ( @expected ) { is( $elements[$i]->_xml_name, $expect->[0], "Got _xml_name '$expect->[0]' as expected", ); is_deeply( $elements[$i]->_xml_attr, $expect->[1], "Got _xml_attr as expected", ); is( $elements[$i]->_xml_content, $expect->[2], "Got _xml_content '$expect->[2]' as expected", ); $i++; } PPI-1.278/t/ppi_token_quote_single.t0000644000175000017500000000163314573465137016027 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Quote::Single use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 32 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; STRING: { my $Document = safe_new \"print 'foo';"; my $Single = $Document->find_first('Token::Quote::Single'); isa_ok( $Single, 'PPI::Token::Quote::Single' ); is( $Single->string, 'foo', '->string returns as expected' ); } LITERAL: { my @pairs = ( "''", '', "'f'", 'f', "'f\\'b'", "f\'b", "'f\\nb'", "f\\nb", "'f\\\\b'", "f\\b", "'f\\\\\\b'", "f\\\\b", "'f\\\\\\\''", "f\\'", ); while ( @pairs ) { my $from = shift @pairs; my $to = shift @pairs; my $doc = safe_new \"print $from;"; my $quote = $doc->find_first('Token::Quote::Single'); isa_ok( $quote, 'PPI::Token::Quote::Single' ); is( $quote->literal, $to, "The source $from becomes $to ok" ); } } PPI-1.278/t/signatures.t0000644000175000017500000000134314573465137013443 0ustar olafolaf#!/usr/bin/perl # PPI doesn't know about signatures, but we just want to ensure that it doesn't # lose newlines when it tracks the content of the token. use strict; use warnings; use PPI::Document (); use Test::More; use lib 't/lib'; use Helper 'safe_new'; my $sigs = <<'EOF'; use strict; use warnings; use feature qw(signatures); no warnings qw(experimental::signatures); sub foo ( $self, $bar, $thing_id = 12 ) { 1; } sub bar ($self,$bar,%) { 2; } sub baz ( $, $bar, $thing_id = 12, @ ) { 1; } sub other ( $= ) { } sub default ( $default = foo() ) { } EOF my $doc = safe_new \$sigs; $doc->serialize; is( $doc->content, $sigs, 'whitespace in signatures is preserved' ); done_testing(); PPI-1.278/t/ppi_token_pod.t0000644000175000017500000000201714573465137014110 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Pod use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 8 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); MERGE: { # Create the test fragments my $one = PPI::Token::Pod->new("=pod\n\nOne\n\n=cut\n"); my $two = PPI::Token::Pod->new("=pod\n\nTwo"); isa_ok( $one, 'PPI::Token::Pod' ); isa_ok( $two, 'PPI::Token::Pod' ); # Create the combined Pod my $merged = PPI::Token::Pod->merge($one, $two); isa_ok( $merged, 'PPI::Token::Pod' ); is( $merged->content, "=pod\n\nOne\n\nTwo\n\n=cut\n", 'Merged POD looks ok' ); } TOKENIZE: { foreach my $test ( [ "=pod\n=cut", [ 'PPI::Token::Pod' ] ], [ "=pod\n=cut\n", [ 'PPI::Token::Pod' ] ], [ "=pod\n=cut\n\n", [ 'PPI::Token::Pod', 'PPI::Token::Whitespace' ] ], [ "=pod\n=Cut\n\n", [ 'PPI::Token::Pod' ] ], # pod doesn't end, so no whitespace token ) { my $T = PPI::Tokenizer->new( \$test->[0] ); my @tokens = map { ref $_ } @{ $T->all_tokens }; is_deeply( \@tokens, $test->[1], 'all tokens as expected' ); } } PPI-1.278/t/01_compile.t0000644000175000017500000000063314573465137013210 0ustar olafolaf#!/usr/bin/perl # This test script only tests that the tree compiles use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 9 + ($ENV{AUTHOR_TESTING} ? 1 : 0); # Do the modules load use_all_ok( qw{ PPI PPI::Tokenizer PPI::Lexer PPI::Dumper PPI::Find PPI::Normal PPI::Util PPI::Cache } ); sub use_all_ok { use_ok $_ for @_ } ok( ! $PPI::XS::VERSION, 'PPI::XS is correctly NOT loaded' ); PPI-1.278/t/ppi_node.t0000644000175000017500000000206514573465137013056 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Node use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 9 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; PRUNE: { # Avoids a bug in old Perls relating to the detection of scripts # Known to occur in ActivePerl 5.6.1 and at least one 5.6.2 install. my $hashbang = reverse 'lrep/nib/rsu/!#'; my $document = safe_new \<<"END_PERL"; $hashbang use strict; sub one { 1 } sub two { 2 } sub three { 3 } print one; print "\n"; print three; print "\n"; exit; END_PERL ok( defined($document->prune ('PPI::Statement::Sub')), 'Pruned multiple subs ok' ); } REMOVE_CHILD: { my $document = safe_new \"1, 2, 3,"; eval { $document->child }; like $@->message, qr/method child\(\) needs an index/; undef $@; eval { $document->child("a") }; like $@->message, qr/method child\(\) needs an index/; my $node = $document->child(0); my $del1 = $node->child(7); is $node->remove_child($del1), $del1; my $fake = bless { content => 3 }, "PPI::Token::Number"; is $node->remove_child($fake), undef; } PPI-1.278/t/ppi_token_quotelike_regexp.t0000644000175000017500000000121114573465137016675 0ustar olafolaf#!/usr/bin/perl use strict; use lib 't/lib'; use PPI::Test::pragmas; # Execute the tests use Test::More tests => 7 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use lib 't/lib'; use Helper qw( check_with ); run(); sub run { check_with "qr{a}i", sub { my $qr = $_->find_first( 'Token::QuoteLike::Regexp' ); ok $qr, 'found qr token'; is $qr->get_match_string, "a", "sucessfully retrieved match string"; is $qr->get_substitute_string, undef, "substitute string method exists but returns undef"; ok $qr->get_modifiers->{i}, "regex modifiers can be queried"; is( ( $qr->get_delimiters )[0], "{}", "delimiters can be retrieved" ); }; } 1; PPI-1.278/t/ppi_token_magic.t0000644000175000017500000000306014573465137014405 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Magic use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 39 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; __TOKENIZER_ON_CHAR: { my $document = safe_new \<<'END_PERL'; $[; # Magic $[ $$; # Magic $$ %-; # Magic %- $#-; # Magic $#- $$foo; # Symbol $foo Dereference of $foo $^W; # Magic $^W $^WIDE_SYSTEM_CALLS; # Magic $^WIDE_SYSTEM_CALLS ${^MATCH}; # Magic ${^MATCH} @{^_Bar}; # Magic @{^_Bar} ${^_Bar}[0]; # Magic @{^_Bar} %{^_Baz}; # Magic %{^_Baz} ${^_Baz}{burfle}; # Magic %{^_Baz} $${^MATCH}; # Magic ${^MATCH} Dereference of ${^MATCH} \${^MATCH}; # Magic ${^MATCH} $0; # Magic $0 -- program being executed $0x2; # Magic $0 -- program being executed $10; # Magic $10 -- capture variable $1100; # Magic $1100 -- capture variable END_PERL $document->index_locations(); my $symbols = $document->find( 'PPI::Token::Symbol' ); is( scalar(@$symbols), 18, 'Found the correct number of symbols' ); my $comments = $document->find( 'PPI::Token::Comment' ); foreach my $token ( @$symbols ) { my ($hash, $class, $name, $remk) = split /\s+/, $comments->[$token->line_number - 1], 4; isa_ok( $token, "PPI::Token::$class" ); is( $token->symbol, $name, $remk || "The symbol is $name" ); } } PPI-1.278/t/ppi_token_quote_literal.t0000644000175000017500000000604514573465137016204 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Quote::Literal use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 23 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); use B qw( perlstring ); use PPI (); use Helper 'safe_new'; STRING: { my $Document = safe_new \"print q{foo}, q!bar!, q , q((foo));"; my $literal = $Document->find('Token::Quote::Literal'); is( scalar(@$literal), 4, '->find returns three objects' ); isa_ok( $literal->[0], 'PPI::Token::Quote::Literal' ); isa_ok( $literal->[1], 'PPI::Token::Quote::Literal' ); isa_ok( $literal->[2], 'PPI::Token::Quote::Literal' ); isa_ok( $literal->[3], 'PPI::Token::Quote::Literal' ); is( $literal->[0]->string, 'foo', '->string returns as expected' ); is( $literal->[1]->string, 'bar', '->string returns as expected' ); is( $literal->[2]->string, 'foo', '->string returns as expected' ); is( $literal->[3]->string, '(foo)', '->string returns as expected' ); } LITERAL: { my $Document = safe_new \"print q{foo}, q!bar!, q , q((foo));"; my $literal = $Document->find('Token::Quote::Literal'); is( $literal->[0]->literal, 'foo', '->literal returns as expected' ); is( $literal->[1]->literal, 'bar', '->literal returns as expected' ); is( $literal->[2]->literal, 'foo', '->literal returns as expected' ); is( $literal->[3]->literal, '(foo)', '->literal returns as expected' ); } test_statement( "use 'SomeModule';", [ 'PPI::Statement::Include' => "use 'SomeModule';", 'PPI::Token::Word' => 'use', 'PPI::Token::Quote::Single' => "'SomeModule'", 'PPI::Token::Structure' => ';', ] ); test_statement( "use q{OtherModule.pm};", [ 'PPI::Statement::Include' => 'use q{OtherModule.pm};', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'q', 'PPI::Structure::Constructor' => '{OtherModule.pm}', 'PPI::Token::Structure' => '{', 'PPI::Statement' => 'OtherModule.pm', 'PPI::Token::Word' => 'OtherModule', 'PPI::Token::Operator' => '.', 'PPI::Token::Word' => 'pm', 'PPI::Token::Structure' => '}', 'PPI::Token::Structure' => ';', ], "invalid syntax is identified correctly", ); sub one_line_explain { my ( $data ) = @_; my @explain = explain $data; s/\n//g for @explain; return join "", @explain; } sub main_level_line { return "" if not $TODO; my @outer_final; my $level = 0; while ( my @outer = caller( $level++ ) ) { @outer_final = @outer; } return "l $outer_final[2] - "; } sub test_statement { local $Test::Builder::Level = $Test::Builder::Level + 1; my ( $code, $expected, $msg ) = @_; $msg = perlstring $code if !defined $msg; my $d = safe_new \$code; my $tokens = $d->find( sub { $_[1]->significant } ); $tokens = [ map { ref( $_ ), $_->content } @$tokens ]; if ( $expected->[0] !~ /^PPI::Statement/ ) { $expected = [ 'PPI::Statement', $code, @$expected ]; } my $ok = is_deeply( $tokens, $expected, main_level_line . $msg ); if ( !$ok ) { diag ">>> $code -- $msg\n"; diag one_line_explain $tokens; diag one_line_explain $expected; } return; } PPI-1.278/t/interactive.t0000644000175000017500000000114414573465137013573 0ustar olafolaf#!/usr/bin/perl # Script used to temporarily test the most recent parser bug. # Testing it here is much more efficient than having to trace # down through the entire set of regression tests. use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 3 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; # Define the test code my $code = 'sub f:f('; ##################################################################### # Run the actual tests my $document = eval { safe_new \$code }; $DB::single = $DB::single = 1 if $@; # Catch exceptions is( $@, '', 'Parsed without error' ); PPI-1.278/t/ppi_token_whitespace.t0000644000175000017500000000066114573465137015465 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Whitespace use lib 't/lib'; use PPI::Test::pragmas; use PPI::Token::Whitespace (); use Test::More tests => 6 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); TIDY: { my $ws1 = PPI::Token::Whitespace::->new( " " ); is $ws1->length, "3"; ok $ws1->tidy; is $ws1->length, "3"; my $ws2 = PPI::Token::Whitespace::->new( " \n" ); is $ws2->length, "4"; ok $ws2->tidy; is $ws2->length, "0"; } PPI-1.278/t/ppi_token_structure.t0000644000175000017500000000137314573465137015372 0ustar olafolaf#!/usr/bin/perl use strict; use lib 't/lib'; use PPI::Test::pragmas; use Helper qw( check_with ); # Execute the tests use Test::More tests => 9 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); run(); sub run { check_with "(1)", sub { my $qr = $_->find_first( 'Token::Structure' ); ok $qr, 'found qr token'; is $qr->snext_sibling, "", "non-semicolon tokens shortcut to empty strong for significant siblings"; is $qr->sprevious_sibling, "", "non-semicolon tokens shortcut to empty strong for significant siblings"; }; check_with "(", sub { my $tokens = $_->find( 'Token::Structure' ); ok $tokens->[0], 'found qr token'; is $tokens->[0]->next_token, '', "empty string is returned as next token for an unclosed structure without children"; }; } 1; PPI-1.278/t/ppi_statement_package.t0000644000175000017500000001113114573465137015602 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Statement::Package use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 2508 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use PPI::Singletons qw( %KEYWORDS ); use Helper 'safe_new'; HASH_CONSTRUCTORS_DONT_CONTAIN_PACKAGES_RT52259: { my $Document = safe_new \<<'END_PERL'; { package => "", }; +{ package => "", }; { 'package' => "", }; +{ 'package' => "", }; { 'package' , "", }; +{ 'package' , "", }; END_PERL my $packages = $Document->find('PPI::Statement::Package'); my $test_name = 'Found no package statements in hash constructors - RT #52259'; if (not $packages) { pass $test_name; } elsif ( not is(scalar @{$packages}, 0, $test_name) ) { diag 'Package statements found:'; diag $_->parent()->parent()->content() foreach @{$packages}; } } INSIDE_SCOPE: { # Create a document with various example package statements my $Document = safe_new \<<'END_PERL'; package Foo; SCOPE: { package # comment Bar::Baz; 1; } package Other v1.23; package Again 0.09; 1; END_PERL # Check that both of the package statements are detected my $packages = $Document->find('Statement::Package'); is( scalar(@$packages), 4, 'Found 2 package statements' ); is( $packages->[0]->namespace, 'Foo', 'Package 1 returns correct namespace' ); is( $packages->[1]->namespace, 'Bar::Baz', 'Package 2 returns correct namespace' ); is( $packages->[2]->namespace, 'Other', 'Package 3 returns correct namespace' ); is( $packages->[3]->namespace, 'Again', 'Package 4 returns correct namespace' ); is( $packages->[0]->file_scoped, 1, '->file_scoped returns true for package 1' ); is( $packages->[1]->file_scoped, '', '->file_scoped returns false for package 2' ); is( $packages->[2]->file_scoped, 1, '->file_scoped returns true for package 3' ); is( $packages->[3]->file_scoped, 1, '->file_scoped returns true for package 4' ); is( $packages->[0]->version, '', 'Package 1 has no version' ); is( $packages->[1]->version, '', 'Package 2 has no version' ); is( $packages->[2]->version, 'v1.23', 'Package 3 returns correct version' ); is( $packages->[3]->version, '0.09', 'Package 4 returns correct version' ); } PERL_5_12_SYNTAX: { my @names = ( # normal name 'Foo', # Keywords must parse as Word and not influence lexing # of subsequent curly braces. keys %KEYWORDS, # regression: misparsed as version string 'v10', # regression GitHub #122: 'x' parsed as x operator 'x64', # Other weird and/or special words, just in case '__PACKAGE__', '__FILE__', '__LINE__', '__SUB__', 'AUTOLOAD', ); my @versions = ( [ 'v1.2.3 ', 'PPI::Token::Number::Version' ], [ 'v1.2.3', 'PPI::Token::Number::Version' ], [ '0.50 ', 'PPI::Token::Number::Float' ], [ '0.50', 'PPI::Token::Number::Float' ], [ '', '' ], # omit version, traditional ); my @blocks = ( [ ';', 'PPI::Token::Structure' ], # traditional package syntax [ '{ 1 }', 'PPI::Structure::Block' ], # 5.12 package syntax ); $_->[2] = strip_ws_padding( $_->[0] ) for @versions, @blocks; for my $name ( @names ) { for my $version_pair ( @versions ) { for my $block_pair ( @blocks ) { my @test = prepare_package_test( $version_pair, $block_pair, $name ); test_package_blocks( @test ); } } } } sub strip_ws_padding { my ( $string ) = @_; $string =~ s/(^\s+|\s+$)//g; return $string; } sub prepare_package_test { my ( $version_pair, $block_pair, $name ) = @_; my ( $version, $version_type, $version_stripped ) = @{$version_pair}; my ( $block, $block_type, $block_stripped ) = @{$block_pair}; my $code = "package $name $version$block"; my $expected_package_tokens = [ [ 'PPI::Token::Word', 'package' ], [ 'PPI::Token::Word', $name ], ($version ne '') ? [ $version_type, $version_stripped ] : (), [ $block_type, $block_stripped ], ]; return ( $code, $expected_package_tokens ); } sub test_package_blocks { my ( $code, $expected_package_tokens ) = @_; subtest "'$code'", sub { my $Document = safe_new \"$code 999;"; is( $Document->schildren, 2, "correct number of statements in document" ); isa_ok( $Document->schild(0), 'PPI::Statement::Package', "entire code" ); # first child is the package statement my $got_tokens = [ map { [ ref $_, "$_" ] } $Document->schild(0)->schildren ]; is_deeply( $got_tokens, $expected_package_tokens, "tokens as expected" ); # second child not swallowed up by the first isa_ok( $Document->schild(1), 'PPI::Statement', "code prior statement end recognized" ); isa_ok( eval { $Document->schild(1)->schild(0) }, 'PPI::Token::Number', "inner code" ); is( eval { $Document->schild(1)->schild(0) }, '999', "number correct" ); }; return; } PPI-1.278/t/23_file.t0000644000175000017500000000117014573465137012500 0ustar olafolaf#!/usr/bin/perl # Testing of PPI::Document::File use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 4 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catfile ); use PPI::Document::File (); ##################################################################### # Creating Documents SCOPE: { # From a specific file my $file = catfile('t', 'data', 'basic.pl'); ok( -f $file, 'Found test file' ); # Load from the file my $doc = PPI::Document::File->new( $file ); isa_ok( $doc, 'PPI::Document::File' ); isa_ok( $doc, 'PPI::Document' ); is( $doc->filename, $file, '->filename ok' ); } PPI-1.278/t/03_document.t0000644000175000017500000000277314573465137013407 0ustar olafolaf#!/usr/bin/perl # PPI::Document tests use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 19 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catfile ); use PPI (); use Helper 'safe_new'; ##################################################################### # Test a basic document # Parse a simple document in all possible ways NEW: { my $file = catfile(qw{ t data 03_document test.dat }); ok( -f $file, 'Found test.dat' ); my $doc1 = safe_new $file; # Test script my $script = <<'END_PERL'; #!/usr/bin/perl # A simple test script print "Hello World!\n"; END_PERL my $doc2 = safe_new \$script; my $doc3 = safe_new [ "#!/usr/bin/perl", "", "# A simple test script", "", "print \"Hello World!\\n\";", ]; # Compare the three forms is_deeply( $doc1, $doc2, 'Stringref form matches file form' ); is_deeply( $doc1, $doc3, 'Arrayref form matches file form' ); } # Repeat the above with a null document NEW_EMPTY: { my $empty = catfile(qw{ t data 03_document empty.dat }); ok( -f $empty, 'Found empty.dat' ); my $doc1 = safe_new $empty; my $doc2 = safe_new \''; my $doc3 = safe_new [ ]; # Compare the three forms is_deeply( $doc1, $doc2, 'Stringref form matches file form' ); is_deeply( $doc1, $doc3, 'Arrayref form matches file form' ); # Make sure the null document round-trips my $string = $doc1->serialize; is( $string, '', '->serialize ok' ); # Check for warnings on null document index_locations { local $^W = 1; $doc1->index_locations(); } } PPI-1.278/t/ppi_statement.t0000644000175000017500000000456514573465137014144 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Statement use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 23 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; SPECIALIZED: { my $Document = safe_new \<<'END_PERL'; package Foo; use strict; ; while (1) { last; } BEGIN { } sub foo { } state $x; $x = 5; END_PERL my $statements = $Document->find('Statement'); is( scalar @{$statements}, 10, 'Found the 10 test statements' ); isa_ok( $statements->[0], 'PPI::Statement::Package', 'Statement 1: isa Package' ); ok( $statements->[0]->specialized, 'Statement 1: is specialized' ); isa_ok( $statements->[1], 'PPI::Statement::Include', 'Statement 2: isa Include' ); ok( $statements->[1]->specialized, 'Statement 2: is specialized' ); isa_ok( $statements->[2], 'PPI::Statement::Null', 'Statement 3: isa Null' ); ok( $statements->[2]->specialized, 'Statement 3: is specialized' ); isa_ok( $statements->[3], 'PPI::Statement::Compound', 'Statement 4: isa Compound' ); ok( $statements->[3]->specialized, 'Statement 4: is specialized' ); isa_ok( $statements->[4], 'PPI::Statement::Expression', 'Statement 5: isa Expression' ); ok( $statements->[4]->specialized, 'Statement 5: is specialized' ); isa_ok( $statements->[5], 'PPI::Statement::Break', 'Statement 6: isa Break' ); ok( $statements->[5]->specialized, 'Statement 6: is specialized' ); isa_ok( $statements->[6], 'PPI::Statement::Scheduled', 'Statement 7: isa Scheduled' ); ok( $statements->[6]->specialized, 'Statement 7: is specialized' ); isa_ok( $statements->[7], 'PPI::Statement::Sub', 'Statement 8: isa Sub' ); ok( $statements->[7]->specialized, 'Statement 8: is specialized' ); isa_ok( $statements->[8], 'PPI::Statement::Variable', 'Statement 9: isa Variable' ); ok( $statements->[8]->specialized, 'Statement 9: is specialized' ); is( ref $statements->[9], 'PPI::Statement', 'Statement 10: is a simple Statement' ); ok( ! $statements->[9]->specialized, 'Statement 10: is not specialized' ); } PPI-1.278/t/ppi_token_regexp.t0000644000175000017500000000146614573465137014627 0ustar olafolaf#!/usr/bin/perl use strict; use lib 't/lib'; use PPI::Test::pragmas; # Execute the tests use Test::More tests => 11 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use lib 't/lib'; use Helper qw( check_with ); run(); sub run { check_with "m{a}i", sub { my $qr = $_->find_first( 'Token::Regexp' ); ok $qr, 'found qr token'; is $qr->get_match_string, "a", "sucessfully retrieved match string"; is $qr->get_substitute_string, undef, "substitute string method exists but returns undef"; ok $qr->get_modifiers->{i}, "regex modifiers can be queried"; is( ( $qr->get_delimiters )[0], "{}", "delimiters can be retrieved" ); }; check_with "s{a}{b}i", sub { my $qr = $_->find_first( 'Token::Regexp' ); ok $qr, 'found qr token'; is $qr->get_substitute_string, "b", "substitute string can be extracted"; }; } 1; PPI-1.278/t/data/0000775000175000017500000000000014573465137012004 5ustar olafolafPPI-1.278/t/data/13_data/0000775000175000017500000000000014573465137013220 5ustar olafolafPPI-1.278/t/data/13_data/Foo.pm0000644000175000017500000000011014573465137014267 0ustar olafolafpackage Foo; print "Hello World!\n"; __DATA__ This is data So is this PPI-1.278/t/data/15_transform/0000775000175000017500000000000014573465137014324 5ustar olafolafPPI-1.278/t/data/15_transform/sample1.pm_out0000644000175000017500000000001514573465137017105 0ustar olafolafmy$foo='bar';PPI-1.278/t/data/15_transform/sample1.pm0000644000175000017500000000002314573465137016215 0ustar olafolafmy $foo = 'bar'; PPI-1.278/t/data/filename.pl0000644000175000017500000000015214573465137014115 0ustar olafolaf#!/usr/bin/perl if ( 1 ) { print "Hello World!\n"; } #line 1000 moo.pl print "Goodbye Blue Sky\n"; 1; PPI-1.278/t/data/basic.pl0000644000175000017500000000007414573465137013421 0ustar olafolaf#!/usr/bin/perl if ( 1 ) { print "Hello World!\n"; } 1; PPI-1.278/t/data/07_token/0000775000175000017500000000000014573465137013432 5ustar olafolafPPI-1.278/t/data/07_token/exp1.code0000644000175000017500000000000714573465137015136 0ustar olafolaf1.e(); PPI-1.278/t/data/07_token/exp2.dump0000644000175000017500000000034114573465137015173 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Operator 'eq' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/07_token/hex.code0000644000175000017500000000000314573465137015041 0ustar olafolaf0xgPPI-1.278/t/data/07_token/exp1.dump0000644000175000017500000000030214573465137015167 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'e' PPI::Structure::List ( ... ) PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/07_token/exp5.dump0000644000175000017500000000034114573465137015176 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'exuals' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/07_token/exp8.code0000644000175000017500000000007614573465137015153 0ustar olafolaf1.exp(1); # don't really care, keyword here is a syntax error PPI-1.278/t/data/07_token/range_operator.code0000644000175000017500000000002414573465137017267 0ustar olafolaf1..2; 12.34..56.78; PPI-1.278/t/data/07_token/hex.dump0000644000175000017500000000013514573465137015102 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Hex '0x' PPI::Token::Word 'g' PPI-1.278/t/data/07_token/exp.dump0000644000175000017500000000267614573465137015126 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Exp '0E0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Exp '1.0e-02' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Exp '1.0E-2' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Exp '1e+10' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Exp '1E+10' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'e' PPI::Token::Number '-1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number '0' PPI::Token::Whitespace ' ' PPI::Token::Word 'e0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Exp '1__E+__1__0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Operator 'ne' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'whatever' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/07_token/exp7.code0000644000175000017500000000001414573465137015142 0ustar olafolaf1.EQUALS 1; PPI-1.278/t/data/07_token/exp4.dump0000644000175000017500000000034114573465137015175 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'equals' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/07_token/exp.code0000644000175000017500000000012214573465137015053 0ustar olafolaf0E0; 1.0e-02; 1.0E-2; 1e+10; 1E+10; e-1; 0 e0; 1__E+__1__0; 1.ne 1; 1.whatever 1; PPI-1.278/t/data/07_token/exp7.dump0000644000175000017500000000034114573465137015200 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'EQUALS' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/07_token/exp4.code0000644000175000017500000000001414573465137015137 0ustar olafolaf1.equals 1; PPI-1.278/t/data/07_token/exp5.code0000644000175000017500000000001414573465137015140 0ustar olafolaf1.exuals 1; PPI-1.278/t/data/07_token/exp3.dump0000644000175000017500000000033614573465137015200 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'eqm' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/07_token/exp6.dump0000644000175000017500000000034114573465137015177 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'Equals' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/07_token/exp8.dump0000644000175000017500000000056314573465137015207 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '1.' PPI::Token::Word 'exp' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Token::Comment '# don't really care, keyword here is a syntax error' PPI::Token::Whitespace '\n' PPI-1.278/t/data/07_token/exp2.code0000644000175000017500000000001014573465137015131 0ustar olafolaf1.eq 1; PPI-1.278/t/data/07_token/exp6.code0000644000175000017500000000001414573465137015141 0ustar olafolaf1.Equals 1; PPI-1.278/t/data/07_token/range_operator.dump0000644000175000017500000000057214573465137017332 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number '1' PPI::Token::Operator '..' PPI::Token::Number '2' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Float '12.34' PPI::Token::Operator '..' PPI::Token::Number::Float '56.78' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/07_token/smart_match.dump0000644000175000017500000000023714573465137016623 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '@foo' PPI::Token::Operator '~~' PPI::Token::Symbol '@bar' PPI::Token::Whitespace '\n' PPI-1.278/t/data/07_token/smart_match.code0000644000175000017500000000001314573465137016560 0ustar olafolaf@foo~~@bar PPI-1.278/t/data/07_token/exp3.code0000644000175000017500000000001114573465137015133 0ustar olafolaf1.eqm 1; PPI-1.278/t/data/test2.txt0000644000175000017500000000024514573465137013605 0ustar olafolaf#!/usr/bin/perl print "Hello World!\n"; =pod =head1 Foo This is the first pod section =cut print "Goodbye World!"; =head1 Bar This is the second pod section PPI-1.278/t/data/27_complete/0000775000175000017500000000000014573465137014124 5ustar olafolafPPI-1.278/t/data/27_complete/02n_helloworld.code0000644000175000017500000000005014573465137017603 0ustar olafolaf#!/usr/bin/perl print "Hello World!\n" PPI-1.278/t/data/27_complete/01y_helloworld.code0000644000175000017500000000005114573465137017616 0ustar olafolaf#!/usr/bin/perl print "Hello World!\n"; PPI-1.278/t/data/11_util/0000775000175000017500000000000014573465137013262 5ustar olafolafPPI-1.278/t/data/11_util/test.pm0000644000175000017500000000003014573465137014566 0ustar olafolafprint "Hello World!\n"; PPI-1.278/t/data/03_document/0000775000175000017500000000000014573465137014124 5ustar olafolafPPI-1.278/t/data/03_document/test.dat0000644000175000017500000000010114573465137015563 0ustar olafolaf#!/usr/bin/perl # A simple test script print "Hello World!\n"; PPI-1.278/t/data/03_document/empty.dat0000644000175000017500000000000014573465137015740 0ustar olafolafPPI-1.278/t/data/26_bom/0000775000175000017500000000000014573465137013070 5ustar olafolafPPI-1.278/t/data/26_bom/utf8.code0000644000175000017500000000001414573465137014603 0ustar olafolafprint 1; PPI-1.278/t/data/26_bom/utf8.dump0000644000175000017500000000032614573465137014644 0ustar olafolafPPI::Document PPI::Token::BOM '' PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/0000775000175000017500000000000014573465137013427 5ustar olafolafPPI-1.278/t/data/05_lexer/10_readline.code0000644000175000017500000000020714573465137016343 0ustar olafolafwhile () {} @foo = ; @foo = <>; print while <>; grep { /foo/ } ; my @v=<$up../*.v>; print while <<>>; for (;<$foo>;) {} PPI-1.278/t/data/05_lexer/05_compound_loops.dump0000644000175000017500000001501714573465137017664 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Token::Word 'while' PPI::Token::Whitespace ' ' PPI::Structure::Condition ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'while' PPI::Token::Whitespace ' ' PPI::Structure::Condition ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Word 'continue' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Label 'LABEL:' PPI::Token::Whitespace ' ' PPI::Token::Word 'while' PPI::Token::Whitespace ' ' PPI::Structure::Condition ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Label 'LABEL:' PPI::Token::Whitespace ' ' PPI::Token::Word 'while' PPI::Token::Whitespace ' ' PPI::Structure::Condition ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Word 'continue' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'until' PPI::Token::Whitespace ' ' PPI::Structure::Condition ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Label 'LABEL:' PPI::Token::Whitespace ' ' PPI::Token::Word 'until' PPI::Token::Whitespace ' ' PPI::Structure::Condition ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'foreach' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Words 'qw{}' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'foreach' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Label 'LABEL:' PPI::Token::Whitespace ' ' PPI::Token::Word 'foreach' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Operator '..' PPI::Token::Whitespace ' ' PPI::Token::Number '20' PPI::Token::Whitespace ' ' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'foreach' PPI::Token::Whitespace ' ' PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'foreach' PPI::Token::Whitespace ' ' PPI::Token::Word 'state' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Token::Word 'state' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'foreach' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Words 'qw' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Structure::For ( ... ) PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$a' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Number '0' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Symbol '$a' PPI::Token::Whitespace ' ' PPI::Token::Operator '<' PPI::Token::Whitespace ' ' PPI::Token::Number '10' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Symbol '$a' PPI::Token::Operator '++' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/03_subroutine_attributes.dump0000644000175000017500000000263614573465137021272 0ustar olafolafPPI::Document PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'bar(quax => &#"Foo")' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Prototype '($)' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Attribute 'bar(quax => &#"Foo")' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Token::Prototype '(&$@)' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'bar' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'baz' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'bingo(blah flasd: fasdf)' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/08_subroutines.code0000644000175000017500000000010214573465137017143 0ustar olafolafBEGIN {} sub BEGIN {} sub {}; sub () {}; sub foo {} sub foo () {} PPI-1.278/t/data/05_lexer/12_switch.dump0000644000175000017500000000175314573465137016125 0ustar olafolafPPI::Document PPI::Statement::Given PPI::Token::Word 'given' PPI::Token::Whitespace ' ' PPI::Structure::Given ( ... ) PPI::Statement::Expression PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Token::Whitespace ' ' PPI::Statement::When PPI::Token::Word 'when' PPI::Token::Whitespace ' ' PPI::Structure::When ( ... ) PPI::Statement::Expression PPI::Token::Symbol '@blah' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI::Token::Whitespace ' ' PPI::Statement::When PPI::Token::Word 'default' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/09_heredoc.dump0000644000175000017500000000351314573465137016237 0ustar olafolafPPI::Document PPI::Token::Comment '# Bareword\n' PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::HereDoc '< &#"Foo") {} sub foo($) :bar(quax => &#"Foo") {} sub foo (&$@): bar : baz : bingo(blah flasd: fasdf) { } PPI-1.278/t/data/05_lexer/10_readline.dump0000644000175000017500000000453614573465137016407 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Token::Word 'while' PPI::Token::Whitespace ' ' PPI::Structure::Condition ( ... ) PPI::Statement::Expression PPI::Token::QuoteLike::Readline '' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '@foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Readline '' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '@foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Readline '<>' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Word 'while' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Readline '<>' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'grep' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Regexp::Match '/foo/' PPI::Token::Whitespace ' ' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Readline '' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '@v' PPI::Token::Operator '=' PPI::Token::QuoteLike::Readline '<$up../*.v>' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Word 'while' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Readline '<<>>' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Structure::For ( ... ) PPI::Statement::Null PPI::Token::Structure ';' PPI::Statement PPI::Token::QuoteLike::Readline '<$foo>' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/05_compound_loops.code0000644000175000017500000000055514573465137017632 0ustar olafolafwhile (1) {} while (1) {} continue {} LABEL: while (1) {} LABEL: while (1) {} continue {} until (1) {} LABEL: until (1) {} foreach qw{} {} foreach () {} LABEL: foreach $foo ( 1 .. 20 ) { } foreach my $foo () {} foreach state $foo () {} for my $foo () {} for state $foo () {} foreach $foo () {} for $foo () {} for $foo qw {} for (my $a = 0; $a < 10; $a++) { } PPI-1.278/t/data/05_lexer/08_subroutines.dump0000644000175000017500000000244214573465137017207 0ustar olafolafPPI::Document PPI::Statement::Scheduled PPI::Token::Word 'BEGIN' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Scheduled PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'BEGIN' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Prototype '()' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Token::Prototype '()' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/13_braces_in_parens.code0000644000175000017500000000013614573465137020061 0ustar olafolafprint({ a => 1 }); print({ STDOUT } 'Hello'); $hashref = ({ %base_args, arg => $mod_value }); PPI-1.278/t/data/05_lexer/02_END.dump0000644000175000017500000000036414573465137015226 0ustar olafolafPPI::Document PPI::Token::Comment '# something\n' PPI::Token::Whitespace '\n' PPI::Statement::End PPI::Token::Separator '__END__' PPI::Token::Whitespace '\n' PPI::Token::End '\nThis is after the end of the file\n\n' PPI-1.278/t/data/05_lexer/06_subroutine_prototypes.code0000644000175000017500000000003414573465137021272 0ustar olafolafsub RE() { } sub foo ($) {} PPI-1.278/t/data/05_lexer/11_dor.code0000644000175000017500000000002714573465137015345 0ustar olafolaf$a //= 1 // die "foo"; PPI-1.278/t/data/05_lexer/11_dor.dump0000644000175000017500000000070514573465137015403 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$a' PPI::Token::Whitespace ' ' PPI::Token::Operator '//=' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Operator '//' PPI::Token::Whitespace ' ' PPI::Token::Word 'die' PPI::Token::Whitespace ' ' PPI::Token::Quote::Double '"foo"' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/09_heredoc.code0000644000175000017500000000043214573465137016201 0ustar olafolaf# Bareword print <' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'print' PPI::Structure::List ( ... ) PPI::Statement::Compound PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Word 'STDOUT' PPI::Token::Whitespace ' ' PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Quote::Single ''Hello'' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$hashref' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Statement PPI::Structure::Constructor { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Symbol '%base_args' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Word 'arg' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$mod_value' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/01_simpleassign.code0000644000175000017500000000003114573465137017251 0ustar olafolafmy $a = 1; state $b = 1; PPI-1.278/t/data/05_lexer/04_anonymous_subroutines.code0000644000175000017500000000006214573465137021254 0ustar olafolafmy $a = sub {}; $b = sub($){}; $c = sub (&$@) {}; PPI-1.278/t/data/05_lexer/07_unmatched_braces.dump0000644000175000017500000000133014573465137020106 0ustar olafolafPPI::Document PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Word 'print' PPI::Structure::List ( ... ??? PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Quote::Double '"Foo"' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n' PPI::Statement::UnmatchedBrace PPI::Token::Structure ')' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/07_unmatched_braces.code0000644000175000017500000000004114573465137020051 0ustar olafolafsub foo { print( "Foo"; } ) PPI-1.278/t/data/05_lexer/04_anonymous_subroutines.dump0000644000175000017500000000206114573465137021310 0ustar olafolafPPI::Document PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$a' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$b' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Word 'sub' PPI::Token::Prototype '($)' PPI::Structure::Block { ... } PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$c' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Prototype '(&$@)' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/05_lexer/01_simpleassign.dump0000644000175000017500000000117114573465137017312 0ustar olafolafPPI::Document PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$a' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement::Variable PPI::Token::Word 'state' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$b' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/24_v6/0000775000175000017500000000000014573465137012644 5ustar olafolafPPI-1.278/t/data/24_v6/Simple.pm0000644000175000017500000000002314573465137014424 0ustar olafolafuse v6-alpha; foo PPI-1.278/t/data/24_v6/Grammar.pm0000644000175000017500000004325414573465137014576 0ustar olafolafuse v6-alpha; grammar KindaPerl6::Grammar { use KindaPerl6::Grammar::Regex; use KindaPerl6::Grammar::Mapping; use KindaPerl6::Grammar::Control; use KindaPerl6::Grammar::Parameters; use KindaPerl6::Grammar::Term; use KindaPerl6::Grammar::Statements; use KindaPerl6::Grammar::Quote; use KindaPerl6::Grammar::Sub; use KindaPerl6::Grammar::Token; my $Class_name; # for diagnostic messages sub get_class_name { $Class_name }; token ident_digit { [ [ | _ | ] | <''> ] }; token ident { | [ | _ ] [ ':<' '>' | '' ] | ¢ }; token full_ident { [ <'::'> | <''> ] }; token namespace { | '::' [ | { return [ $$, @( $$ ) ] } | { return [ $$ ] } ] | { return [ ] } }; token to_line_end { | \N | <''> }; token pod_begin { | \n <'=end'> | . }; token pod_other { | \n <'=cut'> | . }; token ws { [ | <'#'> | \n [ | <'=begin'> | <'=kwid'> | <'=pod'> | <'=for'> | <'=head1'> | <''> ] | \s ] [ | <''> ] }; token opt_ws { | <''> }; token opt_ws2 { | <''> }; token opt_ws3 { | <''> }; token parse { | [ | { return [ $$, @( $$ ) ] } | { return [ $$ ] } ] | { return [] } }; token unit_type { <'class'> | <'grammar'> | <'role'> | <'module'> }; token trait_auxiliary { is | does | meta }; token class_trait { { return [ $$, $$ ] } }; token class_traits { | [ | { return [ $$, @( $$ ) ] } | { return [ $$ ] } ] | { return [] } }; token comp_unit { [\; | <''> ] [ <'use'> <'v6-'> \; | <''> ] [ <'{'> { $Class_name := ~$ } { COMPILER::add_pad( $Class_name ); } <'}'> [\; | <''> ] { my $env := @COMPILER::PAD[0]; COMPILER::drop_pad(); return ::CompUnit( 'unit_type' => $$, 'name' => $$, 'traits' => $$, 'attributes' => { }, 'methods' => { }, 'body' => ::Lit::Code( pad => $env, state => { }, sig => ::Sig( 'invocant' => undef, 'positional' => [ ], 'named' => { } ), body => $$, ), ) } ] | [ { $Class_name := 'Main'; COMPILER::add_pad( $Class_name ); } { my $env := @COMPILER::PAD[0]; COMPILER::drop_pad(); return ::CompUnit( 'unit_type' => 'module', 'name' => 'Main', 'traits' => [], 'attributes' => { }, 'methods' => { }, 'body' => ::Lit::Code( pad => $env, state => { }, sig => ::Sig( 'invocant' => undef, 'positional' => [ ], 'named' => { } ), body => $$, ), ) } ] }; token infix_op { <'+'> | <'-'> | <'*'> | <'/'> | eq | ne | <'=='> | <'!='> | <'&&'> | <'||'> | <'~~'> | <'~'> | '<=>' | '<=' | '>=' | '<' | '>' | '&' | '^' | '|' | '..' }; token hyper_op { <'>>'> | <''> }; token prefix_op { [ '$' | '@' | '%' | '?' | '!' | '++' | '--' | '+' | '-' | '~' | '|' ] }; token declarator { <'my'> | <'state'> | <'has'> | <'our'> }; token opt_declarator { {return $$;} | {return '';} }; token exp2 { { return $$ } }; token exp { # { say 'exp: going to match at ', $/.to; } [ <'??'> [ <'!!'> { # XXX TODO - expand macro # is &ternary: a macro? my $macro_ast := ::Var( 'sigil' => '&', 'twigil' => '', 'name' => 'ternary:', namespace => [ ] ); my $macro := COMPILER::get_var( $macro_ast ); if defined($macro) { # fetch the macro my $sub := ( @COMPILER::PAD[0] ).eval_ast( $macro_ast ); Main::expand_macro( $sub, $$, $$, $$ ); # say "# ternary macro = ", $sub.perl; } return ::Apply( 'code' => ::Var( 'sigil' => '&', 'twigil' => '', 'name' => 'ternary:', namespace => [ ] ), 'arguments' => [ $$, $$, $$ ], ); } | { say '*** Syntax error in ternary operation' } ] | { return ::Apply( 'code' => ::Var( 'sigil' => '&', 'twigil' => '', 'name' => 'infix:<' ~ $ ~ '>', namespace => [ ] ), 'arguments' => [ $$, $$ ], ) } | <'::='> { my $bind := ::Bind( 'parameters' => $$, 'arguments' => $$); COMPILER::begin_block( $bind ); # ::= compile-time return $bind; # := run-time } | <':='> { return ::Bind( 'parameters' => $$, 'arguments' => $$) } | <'='> { return ::Assign( 'parameters' => $$, 'arguments' => $$) } | { return $$ } ] }; token opt_ident { | { return $$ } | <''> { return 'postcircumfix:<( )>' } }; token term_meth { [ \. [ \( \) # { say 'found parameter list: ', $.perl } | \: | { return ::Call( 'invocant' => ::Proto( 'name' => ~$ ), 'method' => $$, 'arguments' => undef, 'hyper' => $$, ) } ] { return ::Call( 'invocant' => ::Proto( 'name' => ~$ ), 'method' => $$, 'arguments' => $$, 'hyper' => $$, ) } ] | [ \. # $obj.(42) [ \( # { say 'testing exp_parameter_list at ', $/.to } \) # { say 'found parameter list: ', $.perl } | \: | { return ::Call( 'invocant' => $$, 'method' => $$, 'arguments' => undef, 'hyper' => $$, ) } ] { return ::Call( 'invocant' => $$, 'method' => $$, 'arguments' => $$, 'hyper' => $$, ) } | \[ \] { return ::Index( 'obj' => $$, 'index' => $$ ) } # $a[exp] | \{ \} { return ::Lookup( 'obj' => $$, 'index' => $$ ) } # $a{exp} | \< \> { return ::Lookup( 'obj' => $$, 'index' => ::Val::Buf( 'buf' => ~$ ), ) } # $a | { return $$ } ] }; token sub_or_method_name { [ \. | <''> ] }; token opt_type { | [ <'::'> | <''> ] { return $$ } | <''> { return '' } }; token use_from_perl5 { ':from' {return 1} | {return 0} } #token index { XXX } #token lookup { XXX } token sigil { \$ |\% |\@ |\& }; token twigil { [ \. | \! | \^ | \* ] | <''> }; # XXX unused? # token var_name { | <'/'> | }; # used in Term.pm token undeclared_var { { # no pre-declaration checks return ::Var( sigil => ~$, twigil => ~$, name => ~$, namespace => $$, ) } }; token var { '/' { return ::Var( sigil => ~$, twigil => '', name => '/', namespace => [ ], ) } | { # check for pre-declaration return COMPILER::get_var( ::Var( sigil => ~$, twigil => ~$, name => ~$, namespace => $$, ) ) } }; token val { | { return $$ } # undef # | $ := # (not exposed to the outside) | { return $$ } # 123 | { return $$ } # True, False | { return $$ } # 123.456 | { return $$ } # 'moose' }; token val_bit { | True { return ::Val::Bit( 'bit' => 1 ) } | False { return ::Val::Bit( 'bit' => 0 ) } }; token val_undef { undef { return ::Val::Undef( ) } }; token val_num { XXX { return 'TODO: val_num' } }; token digits { \d [ | <''> ] }; token val_int { { return ::Val::Int( 'int' => ~$/ ) } }; # XXX obsolete? token exp_seq { | # { say 'exp_seq: matched ' } [ | \, [ \, | <''> ] { return [ $$, @( $$ ) ] } | [ \, | <''> ] { return [ $$ ] } ] | # { say 'exp_seq: end of match' } { return [] } }; token lit { #| { return $$ } # (a, b, c) #| { return $$ } # [a, b, c] #| { return $$ } # {a => x, b => y} #| { return $$ } # sub $x {...} | { return $$ } # ::Tree(a => x, b => y); }; token lit_seq { XXX { return 'TODO: lit_seq' } }; token lit_array { XXX { return 'TODO: lit_array' } }; token lit_hash { XXX { return 'TODO: lit_hash' } }; token lit_code { XXX { return 'TODO - Lit::Code' } }; token lit_object { <'::'> \( [ \) { # say 'Parsing Lit::Object ', $$, ($$).perl; return ::Lit::Object( 'class' => $$, 'fields' => $$ ) } | { say '*** Syntax Error parsing Constructor ',$$; die() } ] }; #token bind { # <':='> # { # return ::Bind( # 'parameters' => $$, # 'arguments' => $$, # ) # } #}; token call { \. \( \) { return ::Call( 'invocant' => $$, 'method' => $$, 'arguments' => $$, ) } }; token apply { [ [ \( \) | ] { return ::Apply( 'code' => COMPILER::get_var( ::Var( sigil => '&', twigil => '', name => $$, namespace => $$, ) ), 'arguments' => $$, ) } | { return ::Apply( 'code' => COMPILER::get_var( ::Var( sigil => '&', twigil => '', name => $$, namespace => $$, ) ), 'arguments' => [], ) } ] }; token opt_name { | '' }; token invocant { | \: { return $$ } | { return undef } }; token capture { # TODO - exp_seq / exp_mapping == positional / named # XXX use exp_parameter_list instead | \: { return ::Capture( 'invocant' => $$, 'array' => $$, 'hash' => [ ] ); } | { return ::Capture( 'invocant' => undef, 'array' => [ ], 'hash' => $$ ); } # ??? doesn't work here #| # { return ::Capture( 'invocant' => undef, 'array' => $$, 'hash' => [ ] ); } }; token sig { # TODO - exp_seq / exp_mapping == positional / named # ??? exp_parameter_list { # say ' invocant: ', ($$).perl; # say ' positional: ', ($$).perl; return ::Sig( 'invocant' => $$, 'positional' => $$, 'named' => { } ); } }; token base_class { } token subset { # example: subset Not_x of Str where { $_ ne 'x' } subset of where \{ # { say ' parsing statement list ' } { COMPILER::add_pad(); } [ \} | { say '*** Syntax Error in subset \'', get_class_name(), '.', $$, '\' near pos=', $/.to; die 'error in Block'; } ] { # say ' block: ', ($$).perl; my $env := @COMPILER::PAD[0]; COMPILER::drop_pad(); return ::Subset( 'name' => $$, 'base_class' => ::Proto( name => $$ ), 'block' => ::Sub( 'name' => undef, 'block' => ::Lit::Code( pad => $env, state => { }, sig => ::Sig( 'invocant' => undef, 'positional' => [ ], 'named' => { } ), body => $$, ), ), ); } } token begin_block { BEGIN \{ { COMPILER::add_pad(); } [ \} | { say '*** Syntax Error in BEGIN near pos=', $/.to; die 'error in Block'; } ] { # say ' block: ', ($$).perl; my $env := @COMPILER::PAD[0]; #print " grammar: dropping pad\n"; COMPILER::drop_pad(); #say "BEGIN block"; #print " grammar: entering begin block\n"; return COMPILER::begin_block( # $env, ::Lit::Code( pad => $env, state => { }, sig => ::Sig( 'invocant' => undef, 'positional' => [ ], 'named' => { } ), body => $$, ), ); } }; token check_block { CHECK \{ [ \} | { say '*** Syntax Error in CHECK block'; die 'error in Block'; } ] { #say "CHECK block"; return COMPILER::check_block( $$ ); } }; } =begin =head1 NAME KindaPerl6::Grammar - Grammar for KindaPerl6 =head1 SYNOPSIS my $match := $source.parse; ($$match).perl; # generated KindaPerl6 AST =head1 DESCRIPTION This module generates a syntax tree for the KindaPerl6 compiler. =head1 AUTHORS The Pugs Team Eperl6-compiler@perl.orgE. =head1 SEE ALSO The Perl 6 homepage at L. The Pugs homepage at L. =head1 COPYRIGHT Copyright 2006, 2007 by Flavio Soibelmann Glock, Audrey Tang and others. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =end PPI-1.278/t/data/08_regression/0000775000175000017500000000000014573465137014473 5ustar olafolafPPI-1.278/t/data/08_regression/21_list_of_refs.code0000644000175000017500000000002014573465137020275 0ustar olafolaf([],[]);({},{});PPI-1.278/t/data/08_regression/05_rt_cpan_13425.code0000644000175000017500000000003414573465137020012 0ustar olafolaf$p{package}; $p{ package }; PPI-1.278/t/data/08_regression/33_magic_carat_long.code0000644000175000017500000000003114573465137021075 0ustar olafolaf$^WIDE_SYSTEM_CALLS = 1; PPI-1.278/t/data/08_regression/16_sub_declaration.code0000644000175000017500000000003014573465137020762 0ustar olafolaf{print 123;} sub foo {} PPI-1.278/t/data/08_regression/15_dash_t.dump0000644000175000017500000000017714573465137017134 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Operator '-t' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/13_goto.code0000644000175000017500000000002214573465137016572 0ustar olafolafsub { goto FOO; } PPI-1.278/t/data/08_regression/16_sub_declaration.dump0000644000175000017500000000074714573465137021034 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Structure::Block { ... } PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Number '123' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/45_heredoc_w_paren_in_terminator.code0000644000175000017500000000027614573465137023720 0ustar olafolaf_+#8r t`-[ <+0cXV!=.?c!c0=)<<~')19_-b+?WW'[z q-y?#m@Wt>.'.xg=}|*w|:+[|9}"mW:Xf()?(cx9*< Vx$*=z09 z&VX`~1/^\/,+f}$_[%q{VW,/b_`9wxx :;gg")~ ~x{)f1<'~y1qsf.-b@V- `;9t\>{`9-'$[@zt;x>%_xt=( !@0PPI-1.278/t/data/08_regression/20_hash_constructor.dump0000644000175000017500000000020614573465137021247 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$a' PPI::Token::Operator '=' PPI::Structure::Constructor { ... } PPI-1.278/t/data/08_regression/25_hash_block.dump0000644000175000017500000000147714573465137017774 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$x' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Structure::Constructor { ... } PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Word 'f' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Structure::Constructor { ... } PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Word 'f' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/17_scope.code0000644000175000017500000000002514573465137016742 0ustar olafolafSCOPE: { print 1; } PPI-1.278/t/data/08_regression/09_for_var.dump0000644000175000017500000000045714573465137017334 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n'PPI-1.278/t/data/08_regression/18_decimal_point.dump0000644000175000017500000000010714573465137020475 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Float '.1234' PPI-1.278/t/data/08_regression/43_nonblock_map.code0000644000175000017500000000005414573465137020274 0ustar olafolaf@foo=map/bar/,@foo; @foo = map /bar/, @foo; PPI-1.278/t/data/08_regression/02_rt_cpan_9582.code0000644000175000017500000000016314573465137017743 0ustar olafolafy {abc} {def}; $foo or $bar; sub y { 1 }; sub or { 1 }; foo->y(); foo->or(); y => 1; $foo->{q}; foo => q'not bar'; PPI-1.278/t/data/08_regression/12_pow.dump0000644000175000017500000000030014573465137016460 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$one' PPI::Token::Operator '**' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$two' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/40_foreach_eval.code0000644000175000017500000000005314573465137020244 0ustar olafolafforeach my $thingy ( eval { bar; } ) { 1 } PPI-1.278/t/data/08_regression/23_rt_cpan_8752.dump0000644000175000017500000000106014573465137017774 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'ok' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Statement PPI::Token::Word 'die' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Quote::Double '"goodbye"' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/08_regression/31_hash_carat_H.dump0000644000175000017500000000023714573465137020231 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Magic '%^H' PPI::Token::Operator '=' PPI::Structure::List ( ... ) PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/19_long_operators.dump0000644000175000017500000000027414573465137020731 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$a' PPI::Token::Whitespace ' ' PPI::Token::Operator '/=' PPI::Token::Whitespace ' ' PPI::Token::Number '2' PPI-1.278/t/data/08_regression/24_compound.code0000644000175000017500000000003014573465137017447 0ustar olafolafeval( {some_code() } ); PPI-1.278/t/data/08_regression/32_readline.dump0000644000175000017500000000066214573465137017453 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '@foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::QuoteLike::Readline '<$fh1>' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::QuoteLike::Readline '<$fh2>' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/46_heredoc_w_paren_in_terminator.code0000644000175000017500000000027614573465137023721 0ustar olafolaf<<~` (y0<"wsxV?[ V q`+"{/*9's, !\*"r %*:>?qzqs|0#m0!-"'= @^{$8z&ww[(WX-Vb:[%(y0${g[ttWzX_*=r_=9==&c|8W"wq1|%[_\[/)8<+%x8&s+W+8X:gz?b%q1xft&x&)fPPI-1.278/t/data/08_regression/01_rt_cpan_19629b.dump0000644000175000017500000000076514573465137020232 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Structure::Block { ... } PPI::Statement PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Number '0' PPI::Token::Whitespace ' ' PPI::Token::Operator '||' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/08_regression/09_for_var.code0000644000175000017500000000001714573465137017271 0ustar olafolaffor $foo () {} PPI-1.278/t/data/08_regression/20_hash_constructor.code0000644000175000017500000000000514573465137021211 0ustar olafolaf$a={}PPI-1.278/t/data/08_regression/50_label_false_positive.dump0000644000175000017500000000341114573465137022036 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Operator '?' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$var' PPI::Token::Operator '->' PPI::Token::Word 'method' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Number '0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Operator '?' PPI::Token::Whitespace ' ' PPI::Token::Word 'var' PPI::Token::Operator '->' PPI::Token::Word 'method' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Number '0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Operator '?' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Symbol '$var' PPI::Token::Operator '->' PPI::Token::Word 'method' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Number '0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Operator '?' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$var::' PPI::Token::Operator '->' PPI::Token::Word 'method' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Number '0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/28_backref_style_heredoc.dump0000644000175000017500000000020214573465137022171 0ustar olafolafPPI::Document PPI::Statement PPI::Token::HereDoc '<<\EOF' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/25_hash_block.code0000644000175000017500000000003114573465137017722 0ustar olafolaf$x = { f => { f => 1 } } PPI-1.278/t/data/08_regression/29_magic_carat.code0000644000175000017500000000001014573465137020060 0ustar olafolaf$^X = 1 PPI-1.278/t/data/08_regression/35_attr_perlsub.code0000644000175000017500000000015614573465137020344 0ustar olafolafsub fnord (&\%) : switch(10,foo(7,3)) : expensive; sub xyzzy : _5x5 { ... } sub plugh () : Ugly('\(") :Bad; PPI-1.278/t/data/08_regression/50_label_false_positive.code0000644000175000017500000000013314573465137022001 0ustar olafolaf1 ? $var->method : 0; 1 ? var->method : 0; 1 ? ($var)->method : 0; 1 ? $var::->method : 0; PPI-1.278/t/data/08_regression/24_compound.dump0000644000175000017500000000067314573465137017517 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'eval' PPI::Structure::List ( ... ) PPI::Statement PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Statement PPI::Token::Word 'some_code' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/11_multiply_vs_glob_cast.dump0000644000175000017500000000027614573465137022272 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$one' PPI::Token::Operator '*' PPI::Token::Symbol '$two' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/30_hash_bang.dump0000644000175000017500000000034014573465137017571 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Magic '%!' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/28_backref_style_heredoc.code0000644000175000017500000000002014573465137022134 0ustar olafolaf<<\EOF; foo EOF PPI-1.278/t/data/08_regression/29_magic_carat.dump0000644000175000017500000000033314573465137020123 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Magic '$^X' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/13_goto.dump0000644000175000017500000000061714573465137016637 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement::Break PPI::Token::Word 'goto' PPI::Token::Whitespace ' ' PPI::Token::Word 'FOO' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/38_multiply.code0000644000175000017500000000000514573465137017511 0ustar olafolaf2*fooPPI-1.278/t/data/08_regression/36_begin_label.code0000644000175000017500000000003514573465137020056 0ustar olafolafBEGIN: { 1; } BEGIN : { 1; } PPI-1.278/t/data/08_regression/06_partial_quote_double.dump0000644000175000017500000000021314573465137022064 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Quote::Double '"Hello...' PPI-1.278/t/data/08_regression/04_tinderbox.dump0000644000175000017500000000274414573465137017670 0ustar olafolafPPI::Document PPI::Statement PPI::Token::ArrayIndex '$#arrayindex' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '%' PPI::Token::Number '2' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '&' PPI::Token::Number '64' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '*' PPI::Token::Number '2' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '%::' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$'foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$::foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Magic '$::|' PPI::Token::Operator '=' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Magic '@0' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Symbol '@c' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/39_foreach_our.code0000644000175000017500000000002514573465137020131 0ustar olafolaffor our $k (@foo) {} PPI-1.278/t/data/08_regression/11_multiply_vs_glob_cast.code0000644000175000017500000000001314573465137022224 0ustar olafolaf$one*$two; PPI-1.278/t/data/08_regression/47_heredoc_w_paren_in_terminator.code0000644000175000017500000000027614573465137023722 0ustar olafolaf.ty*m$s_# w \99&#w[>W\!WfV9s?@]m|=#8X<~=st:)/=y 8^V\w`981]]g m'q,msx/>@{;^>1.@?>[g-9|%` <<~'?w` "^( y>*bV (smy{"0=s=11@!}<8-]/}%-yX"",!8y'z-#$y!'|'$?!bzg.0#Xt:PPI-1.278/t/data/08_regression/39_foreach_our.dump0000644000175000017500000000064514573465137020174 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Token::Word 'for' PPI::Token::Whitespace ' ' PPI::Token::Word 'our' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$k' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Statement PPI::Token::Symbol '@foo' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/44_vstrings.code0000644000175000017500000000030614573465137017512 0ustar olafolaf10.10.10; 1_0.1_0.1_0; 1_0._10.1_0; # .1_0 is seen as a float due to the assumption of strict v10.10.10; v1_0.1_0.1_0; v1_0._10.1_0; # .1_0 is seen as a float due to the assumption of strict .1._wa PPI-1.278/t/data/08_regression/03_rt_cpan_9614.dump0000644000175000017500000000306414573465137017776 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '<<' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '<<' PPI::Token::Whitespace '\n' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '<<' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$bar' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Operator '<<' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::HereDoc '<' PPI::Token::Word 'y' PPI::Structure::List ( ... ) PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'foo' PPI::Token::Operator '->' PPI::Token::Word 'or' PPI::Structure::List ( ... ) PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'y' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Operator '->' PPI::Structure::Subscript { ... } PPI::Statement::Expression PPI::Token::Word 'q' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Quote::Literal 'q'not bar'' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/42_numeric_package.code0000644000175000017500000000002214573465137020741 0ustar olafolafpackage Foo::100; PPI-1.278/t/data/08_regression/22_hash_vs_brace.code0000644000175000017500000000012414573465137020414 0ustar olafolafmap {$_ => 1} @foo; map({$_ => 1} @foo); foo {$_ => 1}, @foo; foo({$_ => 1}, @foo); PPI-1.278/t/data/08_regression/01_rt_cpan_19629.dump0000644000175000017500000000061214573465137020057 0ustar olafolafPPI::Document PPI::Statement PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Number '0' PPI::Token::Whitespace ' ' PPI::Token::Operator '||' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n'PPI-1.278/t/data/08_regression/32_readline.code0000644000175000017500000000003014573465137017405 0ustar olafolaf@foo = (<$fh1>, <$fh2>) PPI-1.278/t/data/08_regression/08_partial_regex_substitution.code0000644000175000017500000000001114573465137023306 0ustar olafolaf$foo =~ sPPI-1.278/t/data/08_regression/05_rt_cpan_13425.dump0000644000175000017500000000101614573465137020046 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$p' PPI::Structure::Subscript { ... } PPI::Statement::Expression PPI::Token::Word 'package' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '$p' PPI::Structure::Subscript { ... } PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Word 'package' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/21_list_of_refs.dump0000644000175000017500000000073614573465137020346 0ustar olafolafPPI::Document PPI::Statement PPI::Structure::List ( ... ) PPI::Statement PPI::Structure::Constructor [ ... ] PPI::Token::Operator ',' PPI::Structure::Constructor [ ... ] PPI::Token::Structure ';' PPI::Statement PPI::Structure::List ( ... ) PPI::Statement PPI::Structure::Constructor { ... } PPI::Token::Operator ',' PPI::Structure::Constructor { ... } PPI::Token::Structure ';' PPI-1.278/t/data/08_regression/49_label_false_positive.code0000644000175000017500000000006014573465137022010 0ustar olafolaf$result = $result_of_expression ? TRUE : FALSE; PPI-1.278/t/data/08_regression/14_minus.code0000644000175000017500000000000414573465137016756 0ustar olafolaf1-1 PPI-1.278/t/data/08_regression/18_decimal_point.code0000644000175000017500000000000514573465137020437 0ustar olafolaf.1234PPI-1.278/t/data/08_regression/07_partial_quote_single.dump0000644000175000017500000000021314573465137022074 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Quote::Single ''Hello...' PPI-1.278/t/data/08_regression/15_dash_t.code0000644000175000017500000000000414573465137017066 0ustar olafolaf-t; PPI-1.278/t/data/08_regression/14_minus.dump0000644000175000017500000000023014573465137017012 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number '1' PPI::Token::Operator '-' PPI::Token::Number '1' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/04_tinderbox.code0000644000175000017500000000011714573465137017625 0ustar olafolaf$#arrayindex; $foo %2; $foo &64; $foo *2; %::; $'foo; $::foo; $::|=1; @0 = @c; PPI-1.278/t/data/08_regression/29_chained_casts.dump0000755000175000017500000000057014573465137020467 0ustar olafolafPPI::Document PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$bar' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Cast '\' PPI::Token::Cast '%' PPI::Token::Cast '*' PPI::Token::Symbol '$foo' PPI::Token::Structure ';' PPI-1.278/t/data/08_regression/48_heredoc_w_paren_in_terminator.code0000644000175000017500000000027614573465137023723 0ustar olafolaf;)&>>qbc{$b|;$XV Xs%-t g*' ^Vs8g?|\}>,1wb[~f|bb{-<)gs:ft}=wy9:c0bb~sq}\f |{^_cmcm\+<0,){=:s?*%s`-0mr&&V[W<>r|`9.'.xg=}|*w|:+[|9}"mW:Xf()?(cx9*<\t\n' PPI-1.278/t/data/08_regression/49_label_false_positive.dump0000644000175000017500000000102314573465137022043 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$result' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$result_of_expression' PPI::Token::Whitespace ' ' PPI::Token::Operator '?' PPI::Token::Whitespace ' ' PPI::Token::Word 'TRUE' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Word 'FALSE' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/31_hash_carat_H.code0000644000175000017500000000000714573465137020171 0ustar olafolaf%^H=() PPI-1.278/t/data/08_regression/08_partial_regex_substitution.dump0000644000175000017500000000031214573465137023345 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=~' PPI::Token::Whitespace ' ' PPI::Token::Regexp::Substitute 's' PPI-1.278/t/data/08_regression/12_pow.code0000644000175000017500000000001414573465137016427 0ustar olafolaf$one** $two PPI-1.278/t/data/08_regression/41_scalar_hash.dump0000644000175000017500000000044714573465137020141 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'scalar' PPI::Token::Whitespace ' ' PPI::Structure::Constructor { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Symbol '%x' PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/01_rt_cpan_19629b.code0000644000175000017500000000001614573465137020164 0ustar olafolaf{(0) || (1);} PPI-1.278/t/data/08_regression/19_long_operators2.dump0000644000175000017500000000027414573465137021013 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '$a' PPI::Token::Whitespace ' ' PPI::Token::Operator '*=' PPI::Token::Whitespace ' ' PPI::Token::Number '2' PPI-1.278/t/data/08_regression/06_partial_quote_double.code0000644000175000017500000000001714573465137022033 0ustar olafolafprint "Hello...PPI-1.278/t/data/08_regression/37_partial_prototype.dump0000644000175000017500000000017514573465137021455 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Prototype '(' PPI-1.278/t/data/08_regression/37_partial_prototype.code0000644000175000017500000000000514573465137021412 0ustar olafolafsub (PPI-1.278/t/data/08_regression/14b_minus.code0000644000175000017500000000001614573465137017123 0ustar olafolaf@{$arr_ref}-1 PPI-1.278/t/data/08_regression/17_scope.dump0000644000175000017500000000067414573465137017007 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Token::Label 'SCOPE:' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\t' PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n'PPI-1.278/t/data/08_regression/34_attr_whitespace.code0000644000175000017500000000010014573465137021010 0ustar olafolafsub foo: Attr { } sub bar : Attr(x y) { } sub baz : Attr( ) { } PPI-1.278/t/data/08_regression/47_heredoc_w_paren_in_terminator.dump0000644000175000017500000000133514573465137023752 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Operator '.' PPI::Token::Word 'ty' PPI::Token::Symbol '*m' PPI::Token::Symbol '$s_' PPI::Token::Comment '# w\t\99&#w[>W\!WfV9s?@]m|=#8X<~=st:)/=y' PPI::Token::Whitespace '\n' PPI::Token::Number '8' PPI::Token::Operator '^' PPI::Token::Word 'V' PPI::Token::Cast '\' PPI::Token::Word 'w' PPI::Token::QuoteLike::Backtick '`981]]g\tm'q,msx/>@{;^>1.@?>[g-9|%`' PPI::Token::Whitespace '\t\t' PPI::Token::HereDoc '<<~'?w` "^(\ty>*bV (smy{"0=s=11@!}<8-]/}%-yX"",!8y'' PPI::Token::Word 'z' PPI::Token::Operator '-' PPI::Token::Comment '#$>' PPI::Token::Word 'qbc' PPI::Structure::Block { ... ??? PPI::Statement PPI::Token::Symbol '$b' PPI::Token::Operator '|' PPI::Token::Structure ';' PPI::Statement PPI::Token::Symbol '$XV' PPI::Token::Whitespace ' ' PPI::Token::Word 'Xs' PPI::Token::Magic '%-' PPI::Token::Word 't' PPI::Token::Whitespace '\t' PPI::Token::Word 'g' PPI::Token::Operator '*' PPI::Token::Quote::Single ''\n^Vs8g?|\}>,1wb[~f|bb{-<)gs:ft}=wy9:c0bb~sq}\f\n|{^_cmcm\+<0,){=:s?*%s`' PPI::Token::Operator '-' PPI::Token::Number '0' PPI::Token::Word 'mr' PPI::Token::Operator '&&' PPI::Token::Word 'V' PPI::Structure::Constructor [ ... ??? PPI::Statement PPI::Token::Word 'W' PPI::Token::QuoteLike::Readline '<>' PPI::Token::Word 'r' PPI::Token::Operator '|' PPI::Token::QuoteLike::Backtick '`9 'bar' }; my $code = { foo => 'bar' }; PPI-1.278/t/data/08_regression/23_rt_cpan_8752.code0000644000175000017500000000003414573465137017741 0ustar olafolafok( sub {die("goodbye")} ); PPI-1.278/t/data/08_regression/38_multiply.dump0000644000175000017500000000017014573465137017547 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number '2' PPI::Token::Operator '*' PPI::Token::Word 'foo' PPI-1.278/t/data/08_regression/07_partial_quote_single.code0000644000175000017500000000001714573465137022043 0ustar olafolafprint 'Hello...PPI-1.278/t/data/08_regression/44_vstrings.dump0000644000175000017500000000246614573465137017556 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Number::Version '10.10.10' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Version '1_0.1_0.1_0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number '1_0' PPI::Token::Operator '.' PPI::Token::Word '_10' PPI::Token::Number::Float '.1_0' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Token::Comment '# .1_0 is seen as a float due to the assumption of strict' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Version 'v10.10.10' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Version 'v1_0.1_0.1_0' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Version 'v1_0' PPI::Token::Operator '.' PPI::Token::Word '_10' PPI::Token::Number::Float '.1_0' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Token::Comment '# .1_0 is seen as a float due to the assumption of strict' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Number::Float '.1' PPI::Token::Operator '.' PPI::Token::Word '_wa' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/26_rt_cpan_23253.dump0000644000175000017500000000211214573465137020047 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$h' PPI::Structure::Subscript { ... } PPI::Statement::Expression PPI::Token::Word 'local' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$h' PPI::Structure::Subscript { ... } PPI::Statement::Expression PPI::Token::Word 'my' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$h' PPI::Structure::Subscript { ... } PPI::Statement::Expression PPI::Token::Word 'our' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$h' PPI::Structure::Subscript { ... } PPI::Statement::Expression PPI::Token::Word 'state' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$h' PPI::Structure::Subscript { ... } PPI::Statement::Expression PPI::Token::Word 'foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/29_chained_casts.code0000755000175000017500000000002214573465137020424 0ustar olafolafmy $bar = \%*$foo;PPI-1.278/t/data/08_regression/35_attr_perlsub.dump0000644000175000017500000000274114573465137020401 0ustar olafolafPPI::Document PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'fnord' PPI::Token::Whitespace ' ' PPI::Token::Prototype '(&\%)' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'switch(10,foo(7,3))' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'expensive' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'xyzzy' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute '_5x5' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Operator '...' PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'plugh' PPI::Token::Whitespace ' ' PPI::Token::Prototype '()' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'Ugly('\(")' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Attribute 'Bad' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/01_rt_cpan_19629.code0000644000175000017500000000001414573465137020020 0ustar olafolaf(0) || (1); PPI-1.278/t/data/08_regression/19_long_operators2.code0000644000175000017500000000000714573465137020752 0ustar olafolaf$a *= 2PPI-1.278/t/data/08_regression/43_nonblock_map.dump0000644000175000017500000000127214573465137020332 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Symbol '@foo' PPI::Token::Operator '=' PPI::Token::Word 'map' PPI::Token::Regexp::Match '/bar/' PPI::Token::Operator ',' PPI::Token::Symbol '@foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Symbol '@foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Token::Word 'map' PPI::Token::Whitespace ' ' PPI::Token::Regexp::Match '/bar/' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Symbol '@foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/10_leading_regexp.dump0000644000175000017500000000046314573465137020640 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Regexp::Match '/./' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Word 'print' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/19_long_operators.code0000644000175000017500000000000714573465137020670 0ustar olafolaf$a /= 2PPI-1.278/t/data/08_regression/30_hash_bang.code0000644000175000017500000000001014573465137017530 0ustar olafolaf%! = () PPI-1.278/t/data/08_regression/34_attr_whitespace.dump0000644000175000017500000000215614573465137021060 0ustar olafolafPPI::Document PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'foo' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'Attr' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'bar' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'Attr(x\ny)' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI::Statement::Sub PPI::Token::Word 'sub' PPI::Token::Whitespace ' ' PPI::Token::Word 'baz' PPI::Token::Whitespace ' ' PPI::Token::Operator ':' PPI::Token::Whitespace ' ' PPI::Token::Attribute 'Attr(\n)' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/36_begin_label.dump0000644000175000017500000000122114573465137020107 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Token::Label 'BEGIN:' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI::Statement::Compound PPI::Token::Label 'BEGIN :' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Number '1' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/46_heredoc_w_paren_in_terminator.dump0000644000175000017500000000041314573465137023745 0ustar olafolafPPI::Document PPI::Statement PPI::Token::HereDoc '<<~` (y0<"wsxV?[\tV q`' PPI::Token::Operator '+' PPI::Token::Quote::Double '"{/*9's,\t!\*"' PPI::Token::Word 'r' PPI::Token::Whitespace '\n'PPI-1.278/t/data/08_regression/42_numeric_package.dump0000644000175000017500000000031414573465137021000 0ustar olafolafPPI::Document PPI::Statement::Package PPI::Token::Word 'package' PPI::Token::Whitespace ' ' PPI::Token::Word 'Foo::100' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/22_hash_vs_brace.dump0000644000175000017500000000366014573465137020457 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Word 'map' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Statement PPI::Token::Magic '$_' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Symbol '@foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'map' PPI::Structure::List ( ... ) PPI::Statement PPI::Structure::Block { ... } PPI::Statement PPI::Token::Magic '$_' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Symbol '@foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Statement PPI::Token::Magic '$_' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Symbol '@foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'foo' PPI::Structure::List ( ... ) PPI::Statement PPI::Structure::Constructor { ... } PPI::Statement PPI::Token::Magic '$_' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Number '1' PPI::Token::Operator ',' PPI::Token::Whitespace ' ' PPI::Token::Symbol '@foo' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/27_constant_hash.dump0000644000175000017500000000223314573465137020524 0ustar olafolafPPI::Document PPI::Statement::Include PPI::Token::Word 'use' PPI::Token::Whitespace ' ' PPI::Token::Word 'constant' PPI::Token::Whitespace ' ' PPI::Structure::Constructor { ... } PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Quote::Single ''bar'' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Statement::Variable PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$code' PPI::Token::Whitespace ' ' PPI::Token::Operator '=' PPI::Token::Whitespace ' ' PPI::Structure::Constructor { ... } PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Word 'foo' PPI::Token::Whitespace ' ' PPI::Token::Operator '=>' PPI::Token::Whitespace ' ' PPI::Token::Quote::Single ''bar'' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/40_foreach_eval.dump0000644000175000017500000000155614573465137020310 0ustar olafolafPPI::Document PPI::Statement::Compound PPI::Token::Word 'foreach' PPI::Token::Whitespace ' ' PPI::Token::Word 'my' PPI::Token::Whitespace ' ' PPI::Token::Symbol '$thingy' PPI::Token::Whitespace ' ' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Word 'eval' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Word 'bar' PPI::Token::Structure ';' PPI::Token::Whitespace ' ' PPI::Token::Whitespace ' ' PPI::Token::Whitespace ' ' PPI::Structure::Block { ... } PPI::Token::Whitespace ' ' PPI::Statement PPI::Token::Number '1' PPI::Token::Whitespace ' ' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/14b_minus.dump0000644000175000017500000000036714573465137017167 0ustar olafolafPPI::Document PPI::Statement PPI::Token::Cast '@' PPI::Structure::Block { ... } PPI::Statement PPI::Token::Symbol '$arr_ref' PPI::Token::Operator '-' PPI::Token::Number '1' PPI::Token::Whitespace '\n' PPI-1.278/t/data/08_regression/10_leading_regexp.code0000644000175000017500000000001614573465137020577 0ustar olafolaf/./ ; print 1 PPI-1.278/t/ppi_element_replace.t0000755000175000017500000000453414573465137015263 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Element use lib 't/lib'; use PPI::Test::pragmas; use PPI::Document (); use Test::More tests => ($ENV{AUTHOR_TESTING} ? 1 : 0) + 28; use Helper 'safe_new'; __REPLACE_METH: { my $Document = safe_new \"print 'Hello World';"; my $string = $Document->find_first('Token::Quote'); isa_ok( $string, 'PPI::Token::Quote' ); is( $string->content, "'Hello World'", 'Got expected token' ); my $foo = PPI::Token::Quote::Single->new("'foo'"); isa_ok( $foo, 'PPI::Token::Quote::Single' ); is( $foo->content, "'foo'", 'Created Quote token' ); $string->replace( $foo ); is( $Document->serialize, "print 'foo';", 'replace works' ); } __REPLACE_CHILD_METH: { my $Document = safe_new \"print 'Hello World';"; my $statement = $Document->find_first('Statement'); isa_ok( $statement, 'PPI::Statement' ); is( $statement->content, "print 'Hello World';", 'Got expected token' ); my $doc = safe_new \'for my $var ( @vars ) { say "foo" }'; my $foo = $doc->find('PPI::Statement::Compound'); isa_ok( $foo->[0], 'PPI::Statement::Compound'); is( $foo->[0]->content, q~for my $var ( @vars ) { say "foo" }~, 'for loop'); ok( $statement->parent->replace_child( $statement, $foo->[0] ), 'replace_child success' ); is( $Document->serialize, 'for my $var ( @vars ) { say "foo" }', 'replace works' ); { my $doc = safe_new \'if ($foo) { ... }'; my $compound = $doc->find('PPI::Statement::Compound'); my $old_child = $compound->[0]->child(2); is( $compound->[0]->child(2), '($foo)', 'found child'); my $replacement = PPI::Token->new('($bar)'); my $statement = $doc->find_first('Statement'); my $success = $statement->replace_child($old_child,$replacement); ok( $success, 'replace_child returns success' ); is( $compound->[0]->child(2), '($bar)', 'child has been replaced'); is( $doc->content, 'if ($bar) { ... }', 'document updated'); } { my $text = 'if ($foo) { ... }'; my $doc = safe_new \$text; my $compound = $doc->find('PPI::Statement::Compound'); is( $compound->[0]->child(2), '($foo)', 'found child'); my $replacement = PPI::Token->new('($bar)'); my $statement = $doc->find_first('Statement'); # Try to replace a child which does not exist. my $success = $statement->replace_child($replacement,$replacement); ok( !$success, 'replace_child returns failure' ); is( $doc->content, $text, 'document not updated'); } } PPI-1.278/t/13_data.t0000755000175000017500000000163614573465137012503 0ustar olafolaf#!/usr/bin/perl # Tests functionality relating to __DATA__ sections of files use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 8 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions qw( catfile ); use PPI (); use Helper 'safe_new'; my $module = catfile('t', 'data', '13_data', 'Foo.pm'); ok( -f $module, 'Test file exists' ); my $Document = safe_new $module; # Get the data token my $Token = $Document->find_first( 'Token::Data' ); isa_ok( $Token, 'PPI::Token::Data' ); # Get the handle my $handle = $Token->handle; isa_ok( $handle, "$]" < 5.008 ? 'IO::String' : 'GLOB' ); # Try to read a line off the handle my $line = <$handle>; is( $line, "This is data\n", "Reading off a handle works as expected" ); # Print to the handle ok( $handle->print("Foo bar\n"), "handle->print returns ok" ); is( $Token->content, "This is data\nFoo bar\nis\n", "handle->print modifies the content as expected" ); PPI-1.278/t/00-report-prereqs.t0000644000175000017500000001360114573465137014466 0ustar olafolaf#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if grep { $_ eq $mod } @exclude; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; if ($mod eq 'perl') { push @reports, ['perl', $want, $]]; next; } my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: PPI-1.278/t/ppi_token__quoteengine_full.t0000644000175000017500000000625614573465137017043 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::_QuoteEngine::Full use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 123 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; NEW: { # Verify that Token::Quote, Token::QuoteLike and Token::Regexp # do not have ->new functions my $RE_SYMBOL = qr/\A(?!\d)\w+\z/; foreach my $name ( qw{Token::Quote Token::QuoteLike Token::Regexp} ) { no strict 'refs'; my @functions = sort grep { defined &{"${name}::$_"} } grep { /$RE_SYMBOL/o } keys %{"PPI::${name}::"}; is( scalar(grep { $_ eq 'new' } @functions), 0, "$name does not have a new function" ); } } # This primarily to ensure that qw() with non-balanced types # are treated the same as those with balanced types. QW: { my @seps = ( undef, undef, '/', '#', ',' ); my @types = ( '()', '<>', '//', '##', ',,' ); my @braced = ( qw{ 1 1 0 0 0 } ); my $i = 0; for my $q ('qw()', 'qw<>', 'qw//', 'qw##', 'qw,,') { my $d = safe_new \$q; my $o = $d->{children}->[0]->{children}->[0]; my $s = $o->{sections}->[0]; is( $o->{operator}, 'qw', "$q correct operator" ); is( $o->{_sections}, 1, "$q correct _sections" ); is( $o->{braced}, $braced[$i], "$q correct braced" ); is( $o->{separator}, $seps[$i], "$q correct separator" ); is( $o->{content}, $q, "$q correct content" ); is( $s->{position}, 3, "$q correct position" ); is( $s->{type}, $types[$i], "$q correct type" ); is( $s->{size}, 0, "$q correct size" ); $i++; } } QW2: { my @stuff = ( qw-( ) < > / / -, '#', '#', ',',',' ); my @seps = ( undef, undef, '/', '#', ',' ); my @braced = ( qw{ 1 1 0 0 0 } ); my @secs = ( qw{ 1 1 1 1 1 } ); my $i = 0; while ( @stuff ) { my $opener = shift @stuff; my $closer = shift @stuff; my $d = safe_new \"qw${opener}a"; my $o = $d->{children}->[0]->{children}->[0]; my $s = $o->{sections}->[0]; is( $o->{operator}, 'qw', "qw$opener correct operator" ); is( $o->{_sections}, $secs[$i], "qw$opener correct _sections" ); is( $o->{braced}, $braced[$i], "qw$opener correct braced" ); is( $o->{separator}, $seps[$i], "qw$opener correct separator" ); is( $o->{content}, "qw${opener}a", "qw$opener correct content" ); if ( $secs[$i] ) { is( $s->{type}, "$opener$closer", "qw$opener correct type" ); } $i++; } } OTHER: { foreach ( [ '/foo/i', 'foo', undef, { i => 1 }, [ '//' ] ], [ 'mx', 'foo', undef, { x => 1 }, [ '<>' ] ], [ 's{foo}[bar]g', 'foo', 'bar', { g => 1 }, [ '{}', '[]' ] ], [ 'tr/fo/ba/', 'fo', 'ba', {}, [ '//', '//' ] ], [ 'qr{foo}smx', 'foo', undef, { s => 1, m => 1, x => 1 }, [ '{}' ] ], ) { my ( $code, $match, $subst, $mods, $delims ) = @{ $_ }; my $doc = safe_new \$code; $doc or warn "'$code' did not create a document"; my $obj = $doc->child( 0 )->child( 0 ); is( $obj->_section_content( 0 ), $match, "$code correct match" ); is( $obj->_section_content( 1 ), $subst, "$code correct subst" ); is_deeply( { $obj->_modifiers() }, $mods, "$code correct modifiers" ); is_deeply( [ $obj->_delimiters() ], $delims, "$code correct delimiters" ); } } PPI-1.278/t/ppi_token_word.t0000644000175000017500000004157714573465137014317 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Word use lib 't/lib'; use PPI::Test::pragmas; use Helper qw( check_with ); use PPI (); use Test::More tests => 2017 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use Helper 'safe_new'; LITERAL: { my @pairs = ( "F", 'F', "Foo::Bar", 'Foo::Bar', "Foo'Bar", 'Foo::Bar', ); while ( @pairs ) { my $from = shift @pairs; my $to = shift @pairs; my $doc = safe_new \"$from;"; my $word = $doc->find_first('Token::Word'); isa_ok( $word, 'PPI::Token::Word' ); is( $word->literal, $to, "The source $from becomes $to ok" ); } } METHOD_CALL: { my $Document = safe_new \<<'END_PERL'; indirect $foo; indirect_class_with_colon Foo::; $bar->method_with_parentheses; print SomeClass->method_without_parentheses + 1; sub_call(); $baz->chained_from->chained_to; a_first_thing a_middle_thing a_last_thing; (first_list_element, second_list_element, third_list_element); first_comma_separated_word, second_comma_separated_word, third_comma_separated_word; single_bareword_statement; { bareword_no_semicolon_end_of_block } $buz{hash_key}; fat_comma_left_side => $thingy; END_PERL my $words = $Document->find('Token::Word'); is( scalar @{$words}, 23, 'Found the 23 test words' ); my %words = map { $_ => $_ } @{$words}; is( scalar $words{indirect}->method_call, undef, 'Indirect notation is unknown.', ); is( scalar $words{indirect_class_with_colon}->method_call, 1, 'Indirect notation with following word ending with colons is true.', ); is( scalar $words{method_with_parentheses}->method_call, 1, 'Method with parentheses is true.', ); is( scalar $words{method_without_parentheses}->method_call, 1, 'Method without parentheses is true.', ); is( scalar $words{print}->method_call, undef, 'Plain print is unknown.', ); is( scalar $words{SomeClass}->method_call, undef, 'Class in class method call is unknown.', ); is( scalar $words{sub_call}->method_call, 0, 'Subroutine call is false.', ); is( scalar $words{chained_from}->method_call, 1, 'Method that is chained from is true.', ); is( scalar $words{chained_to}->method_call, 1, 'Method that is chained to is true.', ); is( scalar $words{a_first_thing}->method_call, undef, 'First bareword is unknown.', ); is( scalar $words{a_middle_thing}->method_call, undef, 'Bareword in the middle is unknown.', ); is( scalar $words{a_last_thing}->method_call, 0, 'Bareword at the end is false.', ); foreach my $false_word ( qw< first_list_element second_list_element third_list_element first_comma_separated_word second_comma_separated_word third_comma_separated_word single_bareword_statement bareword_no_semicolon_end_of_block hash_key fat_comma_left_side > ) { is( scalar $words{$false_word}->method_call, 0, "$false_word is false.", ); } } __TOKENIZER__ON_CHAR: { # PPI::Statement::Operator for my $test ( [ q{$foo and'bar';}, 'and' ], [ q{$foo cmp'bar';}, 'cmp' ], [ q{$foo eq'bar';}, 'eq' ], [ q{$foo ge'bar';}, 'ge' ], [ q{$foo gt'bar';}, 'gt' ], [ q{$foo le'bar';}, 'le' ], [ q{$foo lt'bar';}, 'lt' ], [ q{$foo ne'bar';}, 'ne' ], [ q{$foo not'bar';}, 'not' ], [ q{$foo or'bar';}, 'or' ], [ q{$foo x'bar';}, 'x' ], [ q{$foo xor'bar';}, 'xor' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 2, 'PPI::Token::Operator', $expected, $code ); _compare_child( $statement, 3, 'PPI::Token::Quote::Single', "'bar'", $code ); _compare_child( $statement, 4, 'PPI::Token::Structure', ';', $code ); } # PPI::Token::Quote::* for my $test ( [ q{q'foo';}, q{q'foo'}, 'PPI::Token::Quote::Literal' ], [ q{qq'foo';}, q{qq'foo'}, 'PPI::Token::Quote::Interpolate' ], [ q{qr'foo';}, q{qr'foo'}, 'PPI::Token::QuoteLike::Regexp' ], [ q{qw'foo';}, q{qw'foo'}, 'PPI::Token::QuoteLike::Words' ], [ q{qx'foo';}, q{qx'foo'}, 'PPI::Token::QuoteLike::Command' ], ) { my ( $code, $expected, $type ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, $type, $expected, $code ); _compare_child( $statement, 1, 'PPI::Token::Structure', ';', $code ); } # PPI::Token::Regexp::* for my $test ( [ q{m'foo';}, q{m'foo'}, 'PPI::Token::Regexp::Match' ], [ q{s'foo'bar';}, q{s'foo'bar'}, 'PPI::Token::Regexp::Substitute' ], [ q{tr'fo'ba';}, q{tr'fo'ba'}, 'PPI::Token::Regexp::Transliterate' ], [ q{y'fo'ba';}, q{y'fo'ba'}, 'PPI::Token::Regexp::Transliterate' ], ) { my ( $code, $expected, $type ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, $type, $expected, $code ); _compare_child( $statement, 1, 'PPI::Token::Structure', ';', $code ); } # PPI::Token::Word for my $test ( [ q{abs'3';}, 'abs' ], [ q{accept'1234',2345;}, 'accept' ], [ q{alarm'5';}, 'alarm' ], [ q{atan2'5';}, 'atan2' ], [ q{bind'5',"";}, 'bind' ], [ q{binmode'5';}, 'binmode' ], [ q{bless'foo', 'bar';}, 'bless' ], [ q{break'foo' when 1;}, 'break' ], [ q{caller'3';}, 'caller' ], [ q{chdir'foo';}, 'chdir' ], [ q{chmod'0777', 'foo';}, 'chmod' ], [ q{chomp'a';}, 'chomp' ], [ q{chop'a';}, 'chop' ], [ q{chown'a';}, 'chown' ], [ q{chr'32';}, 'chr' ], [ q{chroot'a';}, 'chroot' ], [ q{close'1';}, 'close' ], [ q{closedir'1';}, 'closedir' ], [ q{connect'1234',$foo;}, 'connect' ], [ q{continue'a';}, 'continue' ], [ q{cos'3';}, 'cos' ], [ q{crypt'foo', 'bar';}, 'crypt' ], [ q{dbmclose'foo';}, 'dbmclose' ], [ q{dbmopen'foo','bar';}, 'dbmopen' ], [ q{default'a' {}}, 'default' ], [ q{defined'foo';}, 'defined' ], [ q{delete'foo';}, 'delete' ], [ q{die'foo';}, 'die' ], [ q{do'foo';}, 'do' ], [ q{dump'foo';}, 'dump' ], [ q{each'foo';}, 'each' ], [ q{else'foo' {};}, 'else' ], [ q{elsif'foo' {};}, 'elsif' ], [ q{endgrent'foo';}, 'endgrent' ], [ q{endhostent'foo';}, 'endhostent' ], [ q{endnetent'foo';}, 'endnetent' ], [ q{endprotoent'foo';}, 'endprotoent' ], [ q{endpwent'foo';}, 'endpwent' ], [ q{endservent'foo';}, 'endservent' ], [ q{eof'foo';}, 'eof' ], [ q{eval'foo';}, 'eval' ], [ q{evalbytes'foo';}, 'evalbytes' ], [ q{exec'foo';}, 'exec' ], [ q{exists'foo';}, 'exists' ], [ q{exit'foo';}, 'exit' ], [ q{exp'foo';}, 'exp' ], [ q{fc'foo';}, 'fc' ], [ q{fcntl'1';}, 'fcntl' ], [ q{fileno'1';}, 'fileno' ], [ q{flock'1', LOCK_EX;}, 'flock' ], [ q{fork'';}, 'fork' ], [ qq{format''=\n.}, 'format' ], [ q{formline'@',1;}, 'formline' ], [ q{getc'1';}, 'getc' ], [ q{getgrent'foo';}, 'getgrent' ], [ q{getgrgid'1';}, 'getgrgid' ], [ q{getgrnam'foo';}, 'getgrnam' ], [ q{gethostbyaddr'1', AF_INET;}, 'gethostbyaddr' ], [ q{gethostbyname'foo';}, 'gethostbyname' ], [ q{gethostent'foo';}, 'gethostent' ], [ q{getlogin'foo';}, 'getlogin' ], [ q{getnetbyaddr'1', AF_INET;}, 'getnetbyaddr' ], [ q{getnetbyname'foo';}, 'getnetbyname' ], [ q{getnetent'foo';}, 'getnetent' ], [ q{getpeername'foo';}, 'getpeername' ], [ q{getpgrp'1';}, 'getpgrp' ], [ q{getppid'1';}, 'getppid' ], [ q{getpriority'1',2;}, 'getpriority' ], [ q{getprotobyname'tcp';}, 'getprotobyname' ], [ q{getprotobynumber'6';}, 'getprotobynumber' ], [ q{getprotoent'foo';}, 'getprotoent' ], [ q{getpwent'foo';}, 'getpwent' ], [ q{getpwnam'foo';}, 'getpwnam' ], [ q{getpwuid'1';}, 'getpwuid' ], [ q{getservbyname'foo', 'bar';}, 'getservbyname' ], [ q{getservbyport'23', 'tcp';}, 'getservbyport' ], [ q{getservent'foo';}, 'getservent' ], [ q{getsockname'foo';}, 'getsockname' ], [ q{getsockopt'foo', 'bar', TCP_NODELAY;}, 'getsockopt' ], [ q{glob'foo';}, 'glob' ], [ q{gmtime'1';}, 'gmtime' ], [ q{goto'label';}, 'goto' ], [ q{hex'1';}, 'hex' ], [ q{index'1','foo';}, 'index' ], [ q{int'1';}, 'int' ], [ q{ioctl'1',1;}, 'ioctl' ], [ q{join'a',@foo;}, 'join' ], [ q{keys'foo';}, 'keys' ], [ q{kill'KILL';}, 'kill' ], [ q{last'label';}, 'last' ], [ q{lc'foo';}, 'lc' ], [ q{lcfirst'foo';}, 'lcfirst' ], [ q{length'foo';}, 'length' ], [ q{link'foo','bar';}, 'link' ], [ q{listen'1234',10;}, 'listen' ], [ q{local'foo';}, 'local' ], [ q{localtime'1';}, 'localtime' ], [ q{lock'foo';}, 'lock' ], [ q{log'foo';}, 'log' ], [ q{lstat'foo';}, 'lstat' ], [ q{mkdir'foo';}, 'mkdir' ], [ q{msgctl'1','foo',1;}, 'msgctl' ], [ q{msgget'1',1}, 'msgget' ], [ q{msgrcv'1',$foo,1,1,1;}, 'msgrcv' ], [ q{msgsnd'1',$foo,1;}, 'msgsnd' ], [ q{my'foo';}, 'my' ], [ q{next'label';}, 'next' ], [ q{oct'foo';}, 'oct' ], [ q{open'foo';}, 'open' ], [ q{opendir'foo';}, 'opendir' ], [ q{ord'foo';}, 'ord' ], [ q{our'foo';}, 'our' ], [ q{pack'H*',$data;}, 'pack' ], [ q{pipe'in','out';}, 'pipe' ], [ q{pop'foo';}, 'pop' ], [ q{pos'foo';}, 'pos' ], [ q{print'foo';}, 'print' ], [ q{printf'foo','bar';}, 'printf' ], [ q{prototype'foo';}, 'prototype' ], [ q{push'foo','bar';}, 'push' ], [ q{quotemeta'foo';}, 'quotemeta' ], [ q{rand'1';}, 'rand' ], [ q{read'1',$foo,100;}, 'read' ], [ q{readdir'1';}, 'readdir' ], [ q{readline'1';}, 'readline' ], [ q{readlink'1';}, 'readlink' ], [ q{readpipe'1';}, 'readpipe' ], [ q{recv'1',$foo,100,1;}, 'recv' ], [ q{redo'label';}, 'redo' ], [ q{ref'foo';}, 'ref' ], [ q{rename'foo','bar';}, 'rename' ], [ q{require'foo';}, 'require' ], [ q{reset'f';}, 'reset' ], [ q{return'foo';}, 'return' ], [ q{reverse'foo','bar';}, 'reverse' ], [ q{rewinddir'1';}, 'rewinddir' ], [ q{rindex'1','foo';}, 'rindex' ], [ q{rmdir'foo';}, 'rmdir' ], [ q{say'foo';}, 'say' ], [ q{scalar'foo','bar';}, 'scalar' ], [ q{seek'1',100,0;}, 'seek' ], [ q{seekdir'1',100;}, 'seekdir' ], [ q{select'1';}, 'select' ], [ q{semctl'1',1,1;}, 'semctl' ], [ q{semget'foo',1,1;}, 'semget' ], [ q{semop'foo','bar';}, 'semop' ], [ q{send'1',$foo'100,1;}, 'send' ], [ q{setgrent'foo';}, 'setgrent' ], [ q{sethostent'1';}, 'sethostent' ], [ q{setnetent'1';}, 'setnetent' ], [ q{setpgrp'1',2;}, 'setpgrp' ], [ q{setpriority'1',2, 3;}, 'setpriority' ], [ q{setprotoent'1';}, 'setprotoent' ], [ q{setpwent'foo';}, 'setpwent' ], [ q{setservent'1';}, 'setservent' ], [ q{setsockopt'1',2,'foo',3;}, 'setsockopt' ], [ q{shift'1','2';}, 'shift' ], [ q{shmctl'1',2,$foo;}, 'shmctl' ], [ q{shmget'1',2,1;}, 'shmget' ], [ q{shmread'1',$foo,0,10;}, 'shmread' ], [ q{shmwrite'1',$foo,0,10;}, 'shmwrite' ], [ q{shutdown'1',0;}, 'shutdown' ], [ q{sin'1';}, 'sin' ], [ q{sleep'1';}, 'sleep' ], [ q{socket'1',2,3,6;}, 'socket' ], [ q{socketpair'1',2,3,4,6;}, 'socketpair' ], [ q{splice'1',2;}, 'splice' ], [ q{split'1','foo';}, 'split' ], [ q{sprintf'foo','bar';}, 'sprintf' ], [ q{sqrt'1';}, 'sqrt' ], [ q{srand'1';}, 'srand' ], [ q{stat'foo';}, 'stat' ], [ q{state'foo';}, 'state' ], [ q{study'foo';}, 'study' ], [ q{substr'foo',1;}, 'substr' ], [ q{symlink'foo','bar';}, 'symlink' ], [ q{syscall'foo';}, 'syscall' ], [ q{sysopen'foo','bar',1;}, 'sysopen' ], [ q{sysread'1',$bar,1;}, 'sysread' ], [ q{sysseek'1',0,0;}, 'sysseek' ], [ q{system'foo';}, 'system' ], [ q{syswrite'1',$bar,1;}, 'syswrite' ], [ q{tell'1';}, 'tell' ], [ q{telldir'1';}, 'telldir' ], [ q{tie'foo',$bar;}, 'tie' ], [ q{tied'foo';}, 'tied' ], [ q{time'foo';}, 'time' ], [ q{times'foo';}, 'times' ], [ q{truncate'foo',1;}, 'truncate' ], [ q{uc'foo';}, 'uc' ], [ q{ucfirst'foo';}, 'ucfirst' ], [ q{umask'foo';}, 'umask' ], [ q{undef'foo';}, 'undef' ], [ q{unlink'foo';}, 'unlink' ], [ q{unpack'H*',$data;}, 'unpack' ], [ q{unshift'1';}, 'unshift' ], [ q{untie'foo';}, 'untie' ], [ q{utime'1','2';}, 'utime' ], [ q{values'foo';}, 'values' ], [ q{vec'1',0.0;}, 'vec' ], [ q{wait'1';}, 'wait' ], [ q{waitpid'1',0;}, 'waitpid' ], [ q{wantarray'foo';}, 'wantarray' ], [ q{warn'foo';}, 'warn' ], [ q{when'foo' {}}, 'when' ], [ q{write'foo';}, 'write' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, 'PPI::Token::Word', $expected, $code ); isa_ok( $statement->child(1), 'PPI::Token::Quote::Single', "$code: second child is a 'PPI::Token::Quote::Single'" ); } for my $test ( [ q{1 for'foo';}, 'for' ], [ q{1 foreach'foo';}, 'foreach' ], [ q{1 if'foo';}, 'if' ], [ q{1 unless'foo';}, 'unless' ], [ q{1 until'foo';}, 'until' ], [ q{1 while'foo';}, 'while' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 2, 'PPI::Token::Word', $expected, $code ); _compare_child( $statement, 3, 'PPI::Token::Quote::Single', "'foo'", $code ); } # Untested: given, grep map, sort, sub # PPI::Statement::Include for my $test ( [ "no'foo';", 'no' ], [ "require'foo';", 'require' ], [ "use'foo';", 'use' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement::Include' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, 'PPI::Token::Word', $expected, $code ); _compare_child( $statement, 1, 'PPI::Token::Quote::Single', "'foo'", $code ); _compare_child( $statement, 2, 'PPI::Token::Structure', ';', $code ); } # PPI::Statement::Package my ( $PackageDocument, $statement ) = _parse_to_statement( "package'foo';", 'PPI::Statement::Package' ); is( $statement, q{package'foo';}, q{package'foo'} ); _compare_child( $statement, 0, 'PPI::Token::Word', 'package', 'package statement' ); _compare_child( $statement, 1, 'PPI::Token::Quote::Single', "'foo'", 'package statement' ); _compare_child( $statement, 2, 'PPI::Token::Structure', ';', 'package statement' ); } sub _parse_to_statement { local $Test::Builder::Level = $Test::Builder::Level+1; my $code = shift; my $type = shift; my $Document = safe_new \$code; my $statements = $Document->find( $type ); is( scalar(@$statements), 1, "$code: got one $type" ); isa_ok( $statements->[0], $type, "$code: got the statement" ); return ( $Document, $statements->[0] ); } sub _compare_child { local $Test::Builder::Level = $Test::Builder::Level+1; my $statement = shift; my $childno = shift; my $type = shift; my $content = shift; my $desc = shift; isa_ok( $statement->child($childno), $type, "$desc child $childno is a $type"); is( $statement->child($childno), $content, "$desc child $childno is 1" ); return; } check_with "1.eqm'bar';", sub { is $_->child( 0 )->child( 1 )->content, "eqm'bar", "eqm' bareword after number and concat op is not mistaken for eq"; }; check_with "__DATA__", sub { is $_->child( 1 ), undef, 'DATA segment without following newline does not get one added'; }; check_with "__DATA__ a", sub { is $_->child( 1 )->content, ' a', 'DATA segment without following newline, but text, has text added as comment in following token'; }; check_with "__END__", sub { is $_->child( 1 ), undef, 'END segment without following newline does not get one added'; }; check_with "__END__ a", sub { is $_->child( 0 )->child( 1 )->content, ' a', 'END segment without following newline, but text, has text added as comment in children list'; }; check_with "__END__ a\n", sub { is $_->child( 0 )->child( 1 )->content, ' a', 'END segment, followed by text and newline, has text added as comment in children list'; }; check_with "__DATA__ a\n", sub { is $_->child( 1 )->content, ' a', 'DATA segment, followed by text and newline, has text added as comment in following token'; }; 1; PPI-1.278/t/lib/0000775000175000017500000000000014573465137011641 5ustar olafolafPPI-1.278/t/lib/Helper.pm0000644000175000017500000000217114573465137013415 0ustar olafolafpackage Helper; use strict; use warnings; use parent 'Exporter'; use Test::More; use PPI::Document (); our @EXPORT_OK = qw( check_with safe_new ); =head1 safe_new @args my $doc = safe_new \"use strict"; Creates a PPI::Document object from the arguments and reports errors if necessary. Can be used to replace most document new calls in the tests for easier testing. =cut sub safe_new { my $Document = PPI::Document->new(@_); my $errstr = PPI::Document->errstr; PPI::Document->_clear; if ( Test::More->builder->in_todo ) { local $TODO = 1; fail "no errors"; fail 'PPI::Document'; return $Document; } is( $errstr, '', "no errors" ); isa_ok $Document, 'PPI::Document'; return $Document; } =head1 check_with check_with "1.eqm'bar';", sub { is $_->child( 0 )->child( 1 )->content, "eqm'bar", "eqm' bareword after number and concat op is not mistaken for eq"; }; Creates a document object from the given code and stores it in $_, so the sub passed in the second argument can quickly run tests on it. =cut sub check_with { my ( $code, $checker ) = @_; local $_ = safe_new \$code; return $checker->(); } 1; PPI-1.278/t/lib/PPI/0000775000175000017500000000000014573465137012271 5ustar olafolafPPI-1.278/t/lib/PPI/Test.pm0000644000175000017500000000170514573465137013547 0ustar olafolafpackage PPI::Test; use warnings; use strict; use File::Spec::Functions (); our @ISA = 'Exporter'; our @EXPORT_OK = qw( find_files quotable pause ); our %EXPORT_TAGS; # Find file names in named t/data dirs sub find_files { my ( $testdir ) = @_; # Does the test directory exist? die "Failed to find test directory $testdir" if !-e $testdir or !-d $testdir or !-r $testdir; # Find the .code test files opendir my $TESTDIR, $testdir or die "opendir: $!"; my @perl = map { File::Spec::Functions::catfile( $testdir, $_ ) } sort grep { /\.(?:code|pm|t)$/ } readdir $TESTDIR; closedir $TESTDIR or die "closedir: $!"; return @perl; } sub quotable { my ( $quotable ) = @_; $quotable =~ s|\\|\\\\|g; $quotable =~ s|\t|\\t|g; $quotable =~ s|\n|\\n|g; $quotable =~ s|\$|\\\$|g; $quotable =~ s|\@|\\\@|g; $quotable =~ s|\"|\\\"|g; return $quotable; } sub pause { local $@; sleep 1 if !eval { require Time::HiRes; Time::HiRes::sleep(0.1); 1 }; } 1; PPI-1.278/t/lib/PPI/Test/0000775000175000017500000000000014573465137013210 5ustar olafolafPPI-1.278/t/lib/PPI/Test/pragmas.pm0000644000175000017500000000220614573465137015176 0ustar olafolafpackage PPI::Test::pragmas; =head1 NAME PPI::Test::pragmas -- standard complier/runtime setup for PPI tests PPI modules do not enable warnings, but this module enables warnings in the tests, and it forces a test failure if any warnings occur. This gives full warnings coverage during the test suite without forcing PPI users to accept an unbounded number of warnings in code they don't control. See L for a fuller explanation of this philosophy. =cut use 5.006; use strict; use warnings; use Test::More 0.88; use if $ENV{AUTHOR_TESTING}, 'Test::Warnings', ':no_end_test'; BEGIN { select STDERR; ## no critic ( InputOutput::ProhibitOneArgSelect ) $| = 1; select STDOUT; ## no critic ( InputOutput::ProhibitOneArgSelect ) $^W++; # throw -w at runtime to try and catch warnings in un-warning-ed modules no warnings 'once'; ## no critic ( TestingAndDebugging::ProhibitNoWarnings ) $PPI::XS_DISABLE = 1; $PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER}; } sub import { strict->import(); warnings->import(); return; } END { Test::Warnings::had_no_warnings() if $ENV{AUTHOR_TESTING}; } 1; PPI-1.278/t/lib/PPI/Test/Run.pm0000644000175000017500000000735614573465137014323 0ustar olafolafpackage PPI::Test::Run; use File::Spec::Functions ':ALL'; use Params::Util qw{_INSTANCE}; use PPI::Document; use PPI::Dumper; use Test::More; use Test::Object; use lib 't/lib'; use PPI::Test::Object; use Helper 'safe_new'; ##################################################################### # Process a .code/.dump file pair # plan: 2 + 14 * npairs sub run_testdir { my $pkg = shift; my $testdir = catdir(@_); # Does the test directory exist? ok( (-e $testdir and -d $testdir and -r $testdir), "Test directory $testdir found" ); # Find the .code test files my @code = do { opendir my $TESTDIR, $testdir or die "opendir: $!"; map { catfile $testdir, $_ } sort grep /\.code$/, readdir $TESTDIR; }; ok( scalar @code, 'Found at least one code file' ); foreach my $codefile ( @code ) { # Does the .code file have a matching .dump file my $dumpfile = $codefile; $dumpfile =~ s/\.code$/\.dump/; my $codename = $codefile; $codename =~ s/\.code$//; my $has_dumpfile = -f $dumpfile and -r $dumpfile; ok( $has_dumpfile, "$codename: Found matching .dump file" ); # Create the lexer and get the Document object my $document = safe_new $codefile; ok( $document, "$codename: Lexer->Document returns true" ); SKIP: { skip "No Document to test", 12 unless $document; # Index locations ok( $document->index_locations, "$codename: ->index_locations ok" ); # Check standard things object_ok( $document ); # 7 tests contained within # Get the dump array ref for the Document object my $Dumper = PPI::Dumper->new( $document ); ok( _INSTANCE($Dumper, 'PPI::Dumper'), "$codename: Object isa PPI::Dumper" ); my @dump_list = $Dumper->list; ok( scalar @dump_list, "$codename: Got dump content from dumper" ); # Try to get the .dump file array my @content = !$has_dumpfile ? () : do { open my $DUMP, '<', $dumpfile or die "open: $!"; binmode $DUMP; <$DUMP>; }; chomp @content; # Compare the two { local $TODO = $ENV{TODO} if $ENV{TODO}; is_deeply( \@dump_list, \@content, "$codename: Generated dump matches stored dump" ) or diag map "$_\n", @dump_list; } } SKIP: { # Also, do a round-trip check skip "No roundtrip check: Couldn't parse code file before", 1 if !$document; skip "No roundtrip check: Couldn't open code file '$codename', $!", 1 unless # my $source = do { open my $CODEFILE, '<', $codefile; binmode $CODEFILE; local $/; <$CODEFILE> }; $source =~ s/(?:\015{1,2}\012|\015|\012)/\n/g; is( $document->serialize, $source, "$codename: Round-trip back to source was ok" ); } } } ##################################################################### # Process a .code/.dump file pair # plan: 2 + 14 * npairs sub increment_testdir { my $pkg = shift; my $testdir = catdir(@_); # Does the test directory exist? ok( (-e $testdir and -d $testdir and -r $testdir), "Test directory $testdir found" ); # Find the .code test files my @code = do { opendir my $TESTDIR, $testdir or die "opendir: $!"; map { catfile $testdir, $_ } sort grep /\.code$/, readdir $TESTDIR; }; ok( scalar @code, 'Found at least one code file' ); for my $codefile ( @code ) { # Does the .code file have a matching .dump file my $codename = $codefile; $codename =~ s/\.code$//; # Load the file my $buffer = do { local $/; open my $CODEFILE, '<', $codefile or die "open: $!"; binmode $CODEFILE; <$CODEFILE>; }; # Cover every possible transitional state in # the regression test code fragments. for my $chars ( 1 .. length $buffer ) { my $string = substr $buffer, 0, $chars; my $document = eval { safe_new \$string }; is( $@ => '', "$codename: $chars chars ok" ); is( $document->serialize => $string, "$codename: $chars char roundtrip" ); } } } 1; PPI-1.278/t/lib/PPI/Test/Object.pm0000755000175000017500000000641314573465137014761 0ustar olafolafpackage PPI::Test::Object; use warnings; use strict; use List::Util 1.33 'any'; use Params::Util qw{_INSTANCE}; use PPI::Dumper; use Test::More; use Test::Object 0.07; ##################################################################### # PPI::Document Testing Test::Object->register( class => 'PPI::Document', tests => 1, code => \&document_ok, ); sub document_ok { my $doc = shift; # A document should have zero or more children that are either # a statement or a non-significant child. my @children = $doc->children; my $good = grep { _INSTANCE($_, 'PPI::Statement') or ( _INSTANCE($_, 'PPI::Token') and ! $_->significant ) } @children; is( $good, scalar(@children), 'Document contains only statements and non-significant tokens' ); 1; } ##################################################################### # Are there an unknowns Test::Object->register( class => 'PPI::Document', tests => 3, code => \&unknown_objects, ); sub unknown_objects { my $doc = shift; is( $doc->find_any('Token::Unknown'), '', "Contains no PPI::Token::Unknown elements", ); is( $doc->find_any('Structure::Unknown'), '', "Contains no PPI::Structure::Unknown elements", ); is( $doc->find_any('Statement::Unknown'), '', "Contains no PPI::Statement::Unknown elements", ); 1; } ##################################################################### # Are there any invalid nestings? Test::Object->register( class => 'PPI::Document', tests => 1, code => \&nested_statements, ); sub nested_statements { my $doc = shift; ok( ! $doc->find_any( sub { _INSTANCE($_[1], 'PPI::Statement') and any { _INSTANCE($_, 'PPI::Statement') } $_[1]->children } ), 'Document contains no nested statements', ); } Test::Object->register( class => 'PPI::Document', tests => 1, code => \&nested_structures, ); sub nested_structures { my $doc = shift; ok( ! $doc->find_any( sub { _INSTANCE($_[1], 'PPI::Structure') and any { _INSTANCE($_, 'PPI::Structure') } $_[1]->children } ), 'Document contains no nested structures', ); } Test::Object->register( class => 'PPI::Document', tests => 1, code => \&no_attribute_in_attribute, ); sub no_attribute_in_attribute { my $doc = shift; ok( ! $doc->find_any( sub { _INSTANCE($_[1], 'PPI::Token::Attribute') and ! exists $_[1]->{_attribute} } ), 'No ->{_attribute} in PPI::Token::Attributes', ); } ##################################################################### # PPI::Statement Tests Test::Object->register( class => 'PPI::Document', tests => 1, code => \&valid_compound_type, ); sub valid_compound_type { my $document = shift; my $compound = $document->find('PPI::Statement::Compound') || []; is( scalar( grep { not defined $_->type } @$compound ), 0, 'All compound statements have defined ->type', ); } ##################################################################### # Does ->location work properly # As an aside, fixes #23788: PPI::Statement::location() returns undef for C<({})>. Test::Object->register( class => 'PPI::Document', tests => 1, code => \&defined_location, ); sub defined_location { my $document = shift; my $bad = $document->find( sub { not defined $_[1]->location } ); is( $bad, '', '->location always defined' ); } 1; PPI-1.278/t/22_readonly.t0000644000175000017500000000151314573465137013376 0ustar olafolaf#!/usr/bin/perl # Testing of readonly functionality use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 12 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI::Document (); use Helper 'safe_new'; ##################################################################### # Creating Documents SCOPE: { # Blank document my $empty = safe_new; is( $empty->readonly, '', '->readonly is false for blank' ); # From source my $source = 'print "Hello World!\n"'; my $doc1 = safe_new \$source; is( $doc1->readonly, '', '->readonly is false by default' ); # With explicit false my $doc2 = safe_new \$source, readonly => undef; is( $doc2->readonly, '', '->readonly is false for explicit false' ); # With explicit true my $doc3 = safe_new \$source, readonly => 2; is( $doc3->readonly, 1, '->readonly is true for explicit true' ); } PPI-1.278/t/06_round_trip.t0000644000175000017500000000476514573465137013764 0ustar olafolaf#!/usr/bin/perl # Load ALL of the PPI files, lex them in, dump them # out, and verify that the code goes in and out cleanly. use lib 't/lib'; use PPI::Test::pragmas; use Test::More; # Plan comes later use File::Spec::Functions qw( catdir ); use PPI (); use PPI::Test qw( find_files ); use Helper 'safe_new'; ##################################################################### # Prepare # Find all of the files to be checked my %tests = map { $_ => $INC{$_} } grep { ! /\bXS\.pm/ } grep { /^PPI\b/ } keys %INC; my @files = sort values %tests; unless ( @files ) { Test::More::plan( tests => ($ENV{AUTHOR_TESTING} ? 1 : 0) + 1 ); ok( undef, "Failed to find any files to test" ); exit(); } # Find all the testable perl files in t/data foreach my $dir ( '05_lexer', '07_token', '08_regression', '11_util', '13_data', '15_transform' ) { my @perl = find_files( catdir( 't', 'data', $dir ) ); push @files, @perl; } # Add the test scripts themselves push @files, find_files( 't' ); # Declare our plan Test::More::plan( tests => ($ENV{AUTHOR_TESTING} ? 1 : 0) + scalar(@files) * 10 - 1 ); ##################################################################### # Run the Tests foreach my $file ( @files ) { roundtrip_ok( $file ); } ##################################################################### # Test Functions sub roundtrip_ok { my $file = shift; local *FILE; my $rv = open( FILE, '<', $file ); ok( $rv, "$file: Found file " ); SKIP: { skip "No file to test", 7 unless $rv; my $source = do { local $/ = undef; }; close FILE; ok( length $source, "$file: Loaded cleanly" ); $source =~ s/(?:\015{1,2}\012|\015|\012)/\n/g; # Load the file as a Document SKIP: { skip( 'Ignoring 14_charset.t', 7 ) if $file =~ /14_charset/; my $Document = safe_new $file; ok( $Document, "$file: ->new returned true" ); # Serialize it back out, and compare with the raw version skip( "Ignoring failed parse of $file", 5 ) unless defined $Document; my $content = $Document->serialize; ok( length($content), "$file: PPI::Document serializes" ); is( $content, $source, "$file: Round trip was successful" ); # Are there any unknown things? is( $Document->find_any('Token::Unknown'), '', "$file: Contains no PPI::Token::Unknown elements" ); is( $Document->find_any('Structure::Unknown'), '', "$file: Contains no PPI::Structure::Unknown elements" ); is( $Document->find_any('Statement::Unknown'), '', "$file: Contains no PPI::Statement::Unknown elements" ); } } } PPI-1.278/t/ppi_token_symbol.t0000644000175000017500000001231314573465137014633 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Token::Symbol use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 216 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; my $Token = PPI::Token::Symbol->new( '$foo' ); isa_ok( $Token, 'PPI::Token::Symbol' ); TOKEN_FROM_PARSE: { parse_and_test( '$x', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '$', symbol => '$x' } ); parse_and_test( '$x[0]', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '@', symbol => '@x' } ); parse_and_test( '$x{0}', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '%', symbol => '%x' } ); parse_and_test( '$::x', { content => '$::x', canonical => '$main::x', raw_type => '$', symbol_type => '$', symbol => '$main::x' } ); parse_and_test( q{$'x}, { content => q{$'x}, canonical => '$main::x', raw_type => '$', symbol_type => '$', symbol => '$main::x' } ); parse_and_test( '@x', { content => '@x', canonical => '@x', raw_type => '@', symbol_type => '@', symbol => '@x' } ); parse_and_test( '@x[0]', { content => '@x', canonical => '@x', raw_type => '@', symbol_type => '@', symbol => '@x' } ); parse_and_test( '@x[0,1]', { content => '@x', canonical => '@x', raw_type => '@', symbol_type => '@', symbol => '@x' } ); parse_and_test( '@x{0}', { content => '@x', canonical => '@x', raw_type => '@', symbol_type => '%', symbol => '%x' } ); parse_and_test( '@::x', { content => '@::x', canonical => '@main::x', raw_type => '@', symbol_type => '@', symbol => '@main::x' } ); parse_and_test( '%x', { content => '%x', canonical => '%x', raw_type => '%', symbol_type => '%', symbol => '%x' } ); parse_and_test( '%x[0]', { content => '%x', canonical => '%x', raw_type => '%', symbol_type => '@', symbol => '@x' } ); parse_and_test( '%x[0,1]', { content => '%x', canonical => '%x', raw_type => '%', symbol_type => '@', symbol => '@x' } ); parse_and_test( '%x{0}', { content => '%x', canonical => '%x', raw_type => '%', symbol_type => '%', symbol => '%x' } ); parse_and_test( '%::x', { content => '%::x', canonical => '%main::x', raw_type => '%', symbol_type => '%', symbol => '%main::x' } ); parse_and_test( '&x', { content => '&x', canonical => '&x', raw_type => '&', symbol_type => '&', symbol => '&x' } ); parse_and_test( '&::x', { content => '&::x', canonical => '&main::x', raw_type => '&', symbol_type => '&', symbol => '&main::x' } ); parse_and_test( '*x', { content => '*x', canonical => '*x', raw_type => '*', symbol_type => '*', symbol => '*x' } ); parse_and_test( '*::x', { content => '*::x', canonical => '*main::x', raw_type => '*', symbol_type => '*', symbol => '*main::x' } ); parse_and_test( '$$x[0]', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '$', symbol => '$x' } ); parse_and_test( '@$x[0]', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '$', symbol => '$x' } ); parse_and_test( '%$x[0]', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '$', symbol => '$x' } ); parse_and_test( '$$x{0}', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '$', symbol => '$x' } ); parse_and_test( '@$x{0}', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '$', symbol => '$x' } ); parse_and_test( '%$x{0}', { content => '$x', canonical => '$x', raw_type => '$', symbol_type => '$', symbol => '$x' } ); } CONSTRUCT_OWN_TOKEN: { # Test behavior that parsing does not support as of PPI 1.220. test_symbol( PPI::Token::Symbol->new('$ foo'), { content => '$ foo', canonical => '$foo', raw_type => '$', symbol_type => '$', symbol => '$foo' }, '$ foo' ); test_symbol( PPI::Token::Symbol->new('$ foo\'bar'), { content => '$ foo\'bar', canonical => '$foo::bar', raw_type => '$', symbol_type => '$', symbol => '$foo::bar' }, '$ foo\'bar' ); # example from PPI::Token::Symbol->canonical documentation test_symbol( PPI::Token::Symbol->new('$ ::foo\'bar::baz'), { content => '$ ::foo\'bar::baz', canonical => '$main::foo::bar::baz', raw_type => '$', symbol_type => '$', symbol => '$main::foo::bar::baz' }, '$ ::foo\'bar::baz' ); } sub parse_and_test { local $Test::Builder::Level = $Test::Builder::Level+1; my ( $code, $symbol_expected, $msg ) = @_; $msg = $code if !defined $msg; my $Document = safe_new \$code; my $symbols = $Document->find( 'PPI::Token::Symbol') || []; is( scalar(@$symbols), 1, "$msg got exactly one symbol" ); test_symbol( $symbols->[0], $symbol_expected, $msg ); return; } sub test_symbol { local $Test::Builder::Level = $Test::Builder::Level+1; my ( $symbol, $symbol_expected, $msg ) = @_; is( $symbol->content, $symbol_expected->{content}, "$msg: content" ); { local $TODO = $ENV{TODO} if $ENV{TODO}; is( $symbol->canonical, $symbol_expected->{canonical}, "$msg: canonical" ); } is( $symbol->raw_type, $symbol_expected->{raw_type}, "$msg: raw_type" ); is( $symbol->symbol_type, $symbol_expected->{symbol_type}, "$msg: symbol_type" ); local $TODO = $ENV{TODO} if $ENV{TODO}; is( $symbol->symbol, $symbol_expected->{symbol}, "$msg: symbol" ); return; } PPI-1.278/t/ppi_normal.t0000644000175000017500000000470514573465137013424 0ustar olafolaf#!/usr/bin/perl # Unit testing for PPI::Normal use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 28 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI (); use Helper 'safe_new'; NEW: { # Check we actually set the layer at creation my $layer_1 = PPI::Normal->new; isa_ok( $layer_1, 'PPI::Normal' ); is( $layer_1->layer, 1, '->new creates a layer 1' ); my $layer_1a = PPI::Normal->new(1); isa_ok( $layer_1a, 'PPI::Normal' ); is( $layer_1a->layer, 1, '->new(1) creates a layer 1' ); my $layer_2 = PPI::Normal->new(2); isa_ok( $layer_2, 'PPI::Normal' ); is( $layer_2->layer, 2, '->new(2) creates a layer 2' ); } BAD: { # Test bad things is( PPI::Normal->new(3), undef, '->new only allows up to layer 2' ); is( PPI::Normal->new(undef), undef, '->new(evil) returns undef' ); is( PPI::Normal->new("foo"), undef, '->new(evil) returns undef' ); is( PPI::Normal->new(\"foo"), undef, '->new(evil) returns undef' ); is( PPI::Normal->new([]), undef, '->new(evil) returns undef' ); is( PPI::Normal->new({}), undef, '->new(evil) returns undef' ); } PROCESS: { my $doc1 = safe_new \'print "Hello World!\n";'; my $doc2 = \'print "Hello World!\n";'; my $doc3 = \' print "Hello World!\n"; # comment'; my $doc4 = \'print "Hello World!\n"'; # Normalize them at level 1 my $layer1 = PPI::Normal->new(1); isa_ok( $layer1, 'PPI::Normal' ); my $nor11 = $layer1->process($doc1->clone); my $nor12 = $layer1->process($doc2); my $nor13 = $layer1->process($doc3); isa_ok( $nor11, 'PPI::Document::Normalized' ); isa_ok( $nor12, 'PPI::Document::Normalized' ); isa_ok( $nor13, 'PPI::Document::Normalized' ); # The first 3 should be the same, the second not is_deeply( { %$nor11 }, { %$nor12 }, 'Layer 1: 1 and 2 match' ); is_deeply( { %$nor11 }, { %$nor13 }, 'Layer 1: 1 and 3 match' ); # Normalize them at level 2 my $layer2 = PPI::Normal->new(2); isa_ok( $layer2, 'PPI::Normal' ); my $nor21 = $layer2->process($doc1); my $nor22 = $layer2->process($doc2); my $nor23 = $layer2->process($doc3); my $nor24 = $layer2->process($doc4); isa_ok( $nor21, 'PPI::Document::Normalized' ); isa_ok( $nor22, 'PPI::Document::Normalized' ); isa_ok( $nor23, 'PPI::Document::Normalized' ); isa_ok( $nor24, 'PPI::Document::Normalized' ); # The first 3 should be the same, the second not is_deeply( { %$nor21 }, { %$nor22 }, 'Layer 2: 1 and 2 match' ); is_deeply( { %$nor21 }, { %$nor23 }, 'Layer 2: 1 and 3 match' ); is_deeply( { %$nor21 }, { %$nor24 }, 'Layer 2: 1 and 4 match' ); } PPI-1.278/LICENSE0000644000175000017500000004642714573465137011650 0ustar olafolafThis software is copyright (c) 2002 by Adam Kennedy. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2002 by Adam Kennedy. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2002 by Adam Kennedy. This is free software, licensed under: The Perl Artistic License 1.0 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End PPI-1.278/MANIFEST0000644000175000017500000002555114573465137011767 0ustar olafolaf# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.031. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile dev_notes.txt dist.ini lib/PPI.pm lib/PPI/Cache.pm lib/PPI/Document.pm lib/PPI/Document/File.pm lib/PPI/Document/Fragment.pm lib/PPI/Document/Normalized.pm lib/PPI/Dumper.pm lib/PPI/Element.pm lib/PPI/Exception.pm lib/PPI/Exception/ParserRejection.pm lib/PPI/Find.pm lib/PPI/Lexer.pm lib/PPI/Node.pm lib/PPI/Normal.pm lib/PPI/Normal/Standard.pm lib/PPI/Singletons.pm lib/PPI/Statement.pm lib/PPI/Statement/Break.pm lib/PPI/Statement/Compound.pm lib/PPI/Statement/Data.pm lib/PPI/Statement/End.pm lib/PPI/Statement/Expression.pm lib/PPI/Statement/Given.pm lib/PPI/Statement/Include.pm lib/PPI/Statement/Include/Perl6.pm lib/PPI/Statement/Null.pm lib/PPI/Statement/Package.pm lib/PPI/Statement/Scheduled.pm lib/PPI/Statement/Sub.pm lib/PPI/Statement/Unknown.pm lib/PPI/Statement/UnmatchedBrace.pm lib/PPI/Statement/Variable.pm lib/PPI/Statement/When.pm lib/PPI/Structure.pm lib/PPI/Structure/Block.pm lib/PPI/Structure/Condition.pm lib/PPI/Structure/Constructor.pm lib/PPI/Structure/For.pm lib/PPI/Structure/Given.pm lib/PPI/Structure/List.pm lib/PPI/Structure/Subscript.pm lib/PPI/Structure/Unknown.pm lib/PPI/Structure/When.pm lib/PPI/Token.pm lib/PPI/Token/ArrayIndex.pm lib/PPI/Token/Attribute.pm lib/PPI/Token/BOM.pm lib/PPI/Token/Cast.pm lib/PPI/Token/Comment.pm lib/PPI/Token/DashedWord.pm lib/PPI/Token/Data.pm lib/PPI/Token/End.pm lib/PPI/Token/HereDoc.pm lib/PPI/Token/Label.pm lib/PPI/Token/Magic.pm lib/PPI/Token/Number.pm lib/PPI/Token/Number/Binary.pm lib/PPI/Token/Number/Exp.pm lib/PPI/Token/Number/Float.pm lib/PPI/Token/Number/Hex.pm lib/PPI/Token/Number/Octal.pm lib/PPI/Token/Number/Version.pm lib/PPI/Token/Operator.pm lib/PPI/Token/Pod.pm lib/PPI/Token/Prototype.pm lib/PPI/Token/Quote.pm lib/PPI/Token/Quote/Double.pm lib/PPI/Token/Quote/Interpolate.pm lib/PPI/Token/Quote/Literal.pm lib/PPI/Token/Quote/Single.pm lib/PPI/Token/QuoteLike.pm lib/PPI/Token/QuoteLike/Backtick.pm lib/PPI/Token/QuoteLike/Command.pm lib/PPI/Token/QuoteLike/Readline.pm lib/PPI/Token/QuoteLike/Regexp.pm lib/PPI/Token/QuoteLike/Words.pm lib/PPI/Token/Regexp.pm lib/PPI/Token/Regexp/Match.pm lib/PPI/Token/Regexp/Substitute.pm lib/PPI/Token/Regexp/Transliterate.pm lib/PPI/Token/Separator.pm lib/PPI/Token/Structure.pm lib/PPI/Token/Symbol.pm lib/PPI/Token/Unknown.pm lib/PPI/Token/Whitespace.pm lib/PPI/Token/Word.pm lib/PPI/Token/_QuoteEngine.pm lib/PPI/Token/_QuoteEngine/Full.pm lib/PPI/Token/_QuoteEngine/Simple.pm lib/PPI/Tokenizer.pm lib/PPI/Transform.pm lib/PPI/Transform/UpdateCopyright.pm lib/PPI/Util.pm lib/PPI/XSAccessor.pm t/00-report-prereqs.dd t/00-report-prereqs.t t/01_compile.t t/03_document.t t/04_element.t t/05_lexer.t t/06_round_trip.t t/07_token.t t/08_regression.t t/09_normal.t t/10_statement.t t/11_util.t t/12_location.t t/13_data.t t/14_charsets.t t/15_transform.t t/16_xml.t t/17_storable.t t/18_cache.t t/19_selftesting.t t/21_exhaustive.t t/22_readonly.t t/23_file.t t/24_v6.t t/25_increment.t t/26_bom.t t/27_complete.t t/28_foreach_qw.t t/29_logical_filename.t t/data/03_document/empty.dat t/data/03_document/test.dat t/data/05_lexer/01_simpleassign.code t/data/05_lexer/01_simpleassign.dump t/data/05_lexer/02_END.code t/data/05_lexer/02_END.dump t/data/05_lexer/03_subroutine_attributes.code t/data/05_lexer/03_subroutine_attributes.dump t/data/05_lexer/04_anonymous_subroutines.code t/data/05_lexer/04_anonymous_subroutines.dump t/data/05_lexer/05_compound_loops.code t/data/05_lexer/05_compound_loops.dump t/data/05_lexer/06_subroutine_prototypes.code t/data/05_lexer/06_subroutine_prototypes.dump t/data/05_lexer/07_unmatched_braces.code t/data/05_lexer/07_unmatched_braces.dump t/data/05_lexer/08_subroutines.code t/data/05_lexer/08_subroutines.dump t/data/05_lexer/09_heredoc.code t/data/05_lexer/09_heredoc.dump t/data/05_lexer/10_readline.code t/data/05_lexer/10_readline.dump t/data/05_lexer/11_dor.code t/data/05_lexer/11_dor.dump t/data/05_lexer/12_switch.code t/data/05_lexer/12_switch.dump t/data/05_lexer/13_braces_in_parens.code t/data/05_lexer/13_braces_in_parens.dump t/data/07_token/exp.code t/data/07_token/exp.dump t/data/07_token/exp1.code t/data/07_token/exp1.dump t/data/07_token/exp2.code t/data/07_token/exp2.dump t/data/07_token/exp3.code t/data/07_token/exp3.dump t/data/07_token/exp4.code t/data/07_token/exp4.dump t/data/07_token/exp5.code t/data/07_token/exp5.dump t/data/07_token/exp6.code t/data/07_token/exp6.dump t/data/07_token/exp7.code t/data/07_token/exp7.dump t/data/07_token/exp8.code t/data/07_token/exp8.dump t/data/07_token/hex.code t/data/07_token/hex.dump t/data/07_token/range_operator.code t/data/07_token/range_operator.dump t/data/07_token/smart_match.code t/data/07_token/smart_match.dump t/data/08_regression/01_rt_cpan_19629.code t/data/08_regression/01_rt_cpan_19629.dump t/data/08_regression/01_rt_cpan_19629b.code t/data/08_regression/01_rt_cpan_19629b.dump t/data/08_regression/02_rt_cpan_9582.code t/data/08_regression/02_rt_cpan_9582.dump t/data/08_regression/03_rt_cpan_9614.code t/data/08_regression/03_rt_cpan_9614.dump t/data/08_regression/04_tinderbox.code t/data/08_regression/04_tinderbox.dump t/data/08_regression/05_rt_cpan_13425.code t/data/08_regression/05_rt_cpan_13425.dump t/data/08_regression/06_partial_quote_double.code t/data/08_regression/06_partial_quote_double.dump t/data/08_regression/07_partial_quote_single.code t/data/08_regression/07_partial_quote_single.dump t/data/08_regression/08_partial_regex_substitution.code t/data/08_regression/08_partial_regex_substitution.dump t/data/08_regression/09_for_var.code t/data/08_regression/09_for_var.dump t/data/08_regression/10_leading_regexp.code t/data/08_regression/10_leading_regexp.dump t/data/08_regression/11_multiply_vs_glob_cast.code t/data/08_regression/11_multiply_vs_glob_cast.dump t/data/08_regression/12_pow.code t/data/08_regression/12_pow.dump t/data/08_regression/13_goto.code t/data/08_regression/13_goto.dump t/data/08_regression/14_minus.code t/data/08_regression/14_minus.dump t/data/08_regression/14b_minus.code t/data/08_regression/14b_minus.dump t/data/08_regression/15_dash_t.code t/data/08_regression/15_dash_t.dump t/data/08_regression/16_sub_declaration.code t/data/08_regression/16_sub_declaration.dump t/data/08_regression/17_scope.code t/data/08_regression/17_scope.dump t/data/08_regression/18_decimal_point.code t/data/08_regression/18_decimal_point.dump t/data/08_regression/19_long_operators.code t/data/08_regression/19_long_operators.dump t/data/08_regression/19_long_operators2.code t/data/08_regression/19_long_operators2.dump t/data/08_regression/20_hash_constructor.code t/data/08_regression/20_hash_constructor.dump t/data/08_regression/21_list_of_refs.code t/data/08_regression/21_list_of_refs.dump t/data/08_regression/22_hash_vs_brace.code t/data/08_regression/22_hash_vs_brace.dump t/data/08_regression/23_rt_cpan_8752.code t/data/08_regression/23_rt_cpan_8752.dump t/data/08_regression/24_compound.code t/data/08_regression/24_compound.dump t/data/08_regression/25_hash_block.code t/data/08_regression/25_hash_block.dump t/data/08_regression/26_rt_cpan_23253.code t/data/08_regression/26_rt_cpan_23253.dump t/data/08_regression/27_constant_hash.code t/data/08_regression/27_constant_hash.dump t/data/08_regression/28_backref_style_heredoc.code t/data/08_regression/28_backref_style_heredoc.dump t/data/08_regression/29_chained_casts.code t/data/08_regression/29_chained_casts.dump t/data/08_regression/29_magic_carat.code t/data/08_regression/29_magic_carat.dump t/data/08_regression/30_hash_bang.code t/data/08_regression/30_hash_bang.dump t/data/08_regression/31_hash_carat_H.code t/data/08_regression/31_hash_carat_H.dump t/data/08_regression/32_readline.code t/data/08_regression/32_readline.dump t/data/08_regression/33_magic_carat_long.code t/data/08_regression/33_magic_carat_long.dump t/data/08_regression/34_attr_whitespace.code t/data/08_regression/34_attr_whitespace.dump t/data/08_regression/35_attr_perlsub.code t/data/08_regression/35_attr_perlsub.dump t/data/08_regression/36_begin_label.code t/data/08_regression/36_begin_label.dump t/data/08_regression/37_partial_prototype.code t/data/08_regression/37_partial_prototype.dump t/data/08_regression/38_multiply.code t/data/08_regression/38_multiply.dump t/data/08_regression/39_foreach_our.code t/data/08_regression/39_foreach_our.dump t/data/08_regression/40_foreach_eval.code t/data/08_regression/40_foreach_eval.dump t/data/08_regression/41_scalar_hash.code t/data/08_regression/41_scalar_hash.dump t/data/08_regression/42_numeric_package.code t/data/08_regression/42_numeric_package.dump t/data/08_regression/43_nonblock_map.code t/data/08_regression/43_nonblock_map.dump t/data/08_regression/44_vstrings.code t/data/08_regression/44_vstrings.dump t/data/08_regression/45_heredoc_w_paren_in_terminator.code t/data/08_regression/45_heredoc_w_paren_in_terminator.dump t/data/08_regression/46_heredoc_w_paren_in_terminator.code t/data/08_regression/46_heredoc_w_paren_in_terminator.dump t/data/08_regression/47_heredoc_w_paren_in_terminator.code t/data/08_regression/47_heredoc_w_paren_in_terminator.dump t/data/08_regression/48_heredoc_w_paren_in_terminator.code t/data/08_regression/48_heredoc_w_paren_in_terminator.dump t/data/08_regression/49_label_false_positive.code t/data/08_regression/49_label_false_positive.dump t/data/08_regression/50_label_false_positive.code t/data/08_regression/50_label_false_positive.dump t/data/11_util/test.pm t/data/13_data/Foo.pm t/data/15_transform/sample1.pm t/data/15_transform/sample1.pm_out t/data/24_v6/Grammar.pm t/data/24_v6/Simple.pm t/data/26_bom/utf8.code t/data/26_bom/utf8.dump t/data/27_complete/01y_helloworld.code t/data/27_complete/02n_helloworld.code t/data/basic.pl t/data/filename.pl t/data/test2.txt t/interactive.t t/lib/Helper.pm t/lib/PPI/Test.pm t/lib/PPI/Test/Object.pm t/lib/PPI/Test/Run.pm t/lib/PPI/Test/pragmas.pm t/marpa.t t/ppi_element.t t/ppi_element_replace.t t/ppi_lexer.t t/ppi_node.t t/ppi_normal.t t/ppi_statement.t t/ppi_statement_compound.t t/ppi_statement_include.t t/ppi_statement_package.t t/ppi_statement_scheduled.t t/ppi_statement_sub.t t/ppi_statement_variable.t t/ppi_token.t t/ppi_token__quoteengine_full.t t/ppi_token_attribute.t t/ppi_token_dashedword.t t/ppi_token_heredoc.t t/ppi_token_magic.t t/ppi_token_number_version.t t/ppi_token_operator.t t/ppi_token_pod.t t/ppi_token_prototype.t t/ppi_token_quote.t t/ppi_token_quote_double.t t/ppi_token_quote_interpolate.t t/ppi_token_quote_literal.t t/ppi_token_quote_single.t t/ppi_token_quotelike_regexp.t t/ppi_token_quotelike_words.t t/ppi_token_regexp.t t/ppi_token_structure.t t/ppi_token_symbol.t t/ppi_token_unknown.t t/ppi_token_whitespace.t t/ppi_token_word.t t/signatures.t xt/DepReqs.pm xt/api.t xt/author.t xt/author/00-compile.t xt/author/distmeta.t xt/author/kwalitee.t xt/author/mojibake.t xt/author/pod-no404s.t xt/author/pod-syntax.t xt/author/portability.t xt/dependent-modules.t xt/meta.t xt/pmv.t xt/release/changes_has_content.t PPI-1.278/dev_notes.txt0000644000175000017500000000236014573465137013356 0ustar olafolafprove -l -v t | grep '^^[ \t]*ok.*TODO' prove -l -v t | grep '^^not ok' prove -vl t\ppi_token_unknown.t | grep '^^[ \t]*ok.*TODO' prove -vl t\ppi_token_unknown.t | grep '^^not ok' prove -l -j 9 t https://github.com/wolfsage/p5-distribution-smoke D:\cpan\p5-distribution-smoke>perl -Ilib bin\p5-distribution-smoke -b new -a Perl::Critic ../PPI D:\cpan\p5-distribution-smoke>perl -Ilib bin\p5-distribution-smoke -b new -r ../PPI perl -Ilib bin/p5-distribution-smoke -r -b new -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -b old -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -a Perl::Critic::* -b new -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -a Perl::Critic::* -b old -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -d 2 -b new -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -d 2 -b old -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI ppi_version change 1.221_02 1.222 dmake clean perl Makefile.PL && dmake && dmake manifest && dmake dist PPI-1.278/Makefile.PL0000644000175000017500000000674314573465137012612 0ustar olafolaf# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.031. use strict; use warnings; use 5.006; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Parse, Analyze and Manipulate Perl (without perl)", "AUTHOR" => "Adam Kennedy ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "PPI", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.006", "NAME" => "PPI", "PREREQ_PM" => { "Carp" => 0, "Clone" => "0.30", "Digest::MD5" => "2.35", "Exporter" => 0, "File::Path" => 0, "File::Spec" => 0, "List::Util" => "1.33", "Params::Util" => "1.00", "Scalar::Util" => 0, "Storable" => "2.17", "Task::Weaken" => 0, "constant" => 0, "if" => 0, "overload" => 0, "strict" => 0 }, "TEST_REQUIRES" => { "B" => 0, "Class::Inspector" => "1.22", "Encode" => 0, "ExtUtils::MakeMaker" => 0, "File::Copy" => 0, "File::Spec" => 0, "File::Spec::Functions" => 0, "File::Temp" => 0, "Test::More" => "0.96", "Test::NoWarnings" => 0, "Test::Object" => "0.07", "Test::SubCalls" => "1.07", "lib" => 0, "parent" => 0, "utf8" => 0, "warnings" => 0 }, "VERSION" => "1.278", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "B" => 0, "Carp" => 0, "Class::Inspector" => "1.22", "Clone" => "0.30", "Digest::MD5" => "2.35", "Encode" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Copy" => 0, "File::Path" => 0, "File::Spec" => 0, "File::Spec::Functions" => 0, "File::Temp" => 0, "List::Util" => "1.33", "Params::Util" => "1.00", "Scalar::Util" => 0, "Storable" => "2.17", "Task::Weaken" => 0, "Test::More" => "0.96", "Test::NoWarnings" => 0, "Test::Object" => "0.07", "Test::SubCalls" => "1.07", "constant" => 0, "if" => 0, "lib" => 0, "overload" => 0, "parent" => 0, "strict" => 0, "utf8" => 0, "warnings" => 0 ); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 requires('File::Spec', is_os('MSWin32') ? '3.2701' : '0.84'); requires('IO::String') if $] < '5.008000'; unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 sub _add_prereq { my ($mm_key, $module, $version_or_range) = @_; $version_or_range ||= 0; warn "$module already exists in $mm_key (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" if exists $WriteMakefileArgs{$mm_key}{$module} and $WriteMakefileArgs{$mm_key}{$module} ne '0' and $WriteMakefileArgs{$mm_key}{$module} ne $version_or_range; warn "$module already exists in FallbackPrereqs (at version $FallbackPrereqs{$module}) -- need to do a sane metamerge!" if exists $FallbackPrereqs{$module} and $FallbackPrereqs{$module} ne '0' and $FallbackPrereqs{$module} ne $version_or_range; $WriteMakefileArgs{$mm_key}{$module} = $FallbackPrereqs{$module} = $version_or_range; return; } sub is_os { foreach my $os (@_) { return 1 if $os eq $^O; } return 0; } sub requires { goto &runtime_requires } sub runtime_requires { my ($module, $version_or_range) = @_; _add_prereq(PREREQ_PM => $module, $version_or_range); } PPI-1.278/dist.ini0000644000175000017500000000474414573465137012303 0ustar olafolafname = PPI author = Adam Kennedy license = Perl_5 copyright_holder = Adam Kennedy copyright_year = 2002 [MetaResources] homepage = https://github.com/Perl-Critic/PPI bugtracker = https://github.com/Perl-Critic/PPI/issues repository = https://github.com/Perl-Critic/PPI [Encoding] ; exclude paths from autoprereqs detection encoding = bytes match = ^t/data/ [AutoPrereqs] ; to lower the risk of stuff getting overlooked skip = Class::XSAccessor ; used only in an experimental module skip = Time::HiRes ; optional, only used to speed up testing a little skip = PPI::XS ; optional, experimental [Prereqs] ; Force the existence of the weaken function ; (which some distributions annoyingly don't have) Task::Weaken = 0 [Prereqs / TestRequires] Test::More = 0.96 [DynamicPrereqs] -body = requires('File::Spec', is_os('MSWin32') ? '3.2701' : '0.84'); -body = requires('IO::String') if $] < '5.008000'; [Git::GatherDir] exclude_filename = README.pod [MetaYAML] [MetaJSON] [Readme] [Manifest] [License] [MakeMaker] [CPANFile] [Test::Compile] :version = 2.039 bail_out_on_fail = 1 xt_mode = 1 ;[Test::NoTabs] ;[Test::EOL] [MetaTests] ;[Test::CPAN::Changes] [Test::ChangesHasContent] [PodSyntaxTests] ;[PodCoverageTests] ;[Test::PodSpelling] [Test::Pod::No404s] [Test::Kwalitee] :version = 2.10 filename = xt/author/kwalitee.t [MojibakeTests] :version = 0.8 [Test::ReportPrereqs] :version = 0.022 verify_prereqs = 1 version_extractor = ExtUtils::MakeMaker [Test::Portability] ;[Test::CleanNamespaces] [MetaProvides::Package] [MetaConfig] [Keywords] [Git::Contributors] [RunExtraTests] [Git::Check / initial check] [Git::CheckFor::MergeConflicts] [Git::CheckFor::CorrectBranch] :version = 0.004 release_branch = master [CheckPrereqsIndexed] :version = 0.019 [TestRelease] [Git::Check / after tests] [UploadToCPAN] ; The distribution version is calculated from the last git tag. ; To override, use V= dzil ... [@Git::VersionManager] RewriteVersion::Transitional.fallback_version_provider = Git::NextVersion NextRelease.format = %-6v %{yyyy-MM-dd HH:mm:ss'Z'}d%{ (TRIAL RELEASE)}T release snapshot.:version = 2.046 release snapshot.add_files_in = . release snapshot.commit_msg = %N-%v%t%n%n%c Git::Tag.tag_format = v%v Git::Tag.tag_message = v%v%t [ReadmeAnyFromPod] :version = 0.142180 type = pod location = root phase = release [Git::Push] ; listed late, to allow all other plugins which do BeforeRelease checks to run first. [ConfirmRelease] PPI-1.278/README0000644000175000017500000000056614573465137011515 0ustar olafolafThis archive contains the distribution PPI, version 1.278: Parse, Analyze and Manipulate Perl (without perl) This software is copyright (c) 2002 by Adam Kennedy. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v6.031. PPI-1.278/cpanfile0000644000175000017500000000414414573465137012335 0ustar olafolaf# This file is generated by Dist::Zilla::Plugin::CPANFile v6.031 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "Clone" => "0.30"; requires "Digest::MD5" => "2.35"; requires "Exporter" => "0"; requires "File::Path" => "0"; requires "File::Spec" => "0"; requires "List::Util" => "1.33"; requires "Params::Util" => "1.00"; requires "Scalar::Util" => "0"; requires "Storable" => "2.17"; requires "Task::Weaken" => "0"; requires "constant" => "0"; requires "if" => "0"; requires "overload" => "0"; requires "perl" => "5.006"; requires "strict" => "0"; on 'test' => sub { requires "B" => "0"; requires "Class::Inspector" => "1.22"; requires "Encode" => "0"; requires "ExtUtils::MakeMaker" => "0"; requires "File::Copy" => "0"; requires "File::Spec" => "0"; requires "File::Spec::Functions" => "0"; requires "File::Temp" => "0"; requires "Test::More" => "0.96"; requires "Test::NoWarnings" => "0"; requires "Test::Object" => "0.07"; requires "Test::SubCalls" => "1.07"; requires "lib" => "0"; requires "parent" => "0"; requires "utf8" => "0"; requires "warnings" => "0"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Devel::Confess" => "0"; requires "Encode" => "0"; requires "File::Spec" => "0"; requires "IO::All" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "MetaCPAN::Client" => "0"; requires "Test2::V0" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::ClassAPI" => "0"; requires "Test::DependentModules" => "0"; requires "Test::Kwalitee" => "1.21"; requires "Test::Mojibake" => "0"; requires "Test::More" => "0.94"; requires "Test::Pod" => "1.41"; requires "Test::Pod::No404s" => "0"; requires "Test::Portability::Files" => "0"; requires "lib" => "0"; requires "perl" => "5.010"; requires "strictures" => "2"; requires "warnings" => "0"; }; on 'develop' => sub { recommends "Dist::Zilla::PluginBundle::Git::VersionManager" => "0.007"; }; PPI-1.278/META.json0000644000175000017500000010444714573465137012261 0ustar olafolaf{ "abstract" : "Parse, Analyze and Manipulate Perl (without perl)", "author" : [ "Adam Kennedy " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.031, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PPI", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "recommends" : { "Dist::Zilla::PluginBundle::Git::VersionManager" : "0.007" }, "requires" : { "Devel::Confess" : "0", "Encode" : "0", "File::Spec" : "0", "IO::All" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "MetaCPAN::Client" : "0", "Test2::V0" : "0", "Test::CPAN::Meta" : "0", "Test::ClassAPI" : "0", "Test::DependentModules" : "0", "Test::Kwalitee" : "1.21", "Test::Mojibake" : "0", "Test::More" : "0.94", "Test::Pod" : "1.41", "Test::Pod::No404s" : "0", "Test::Portability::Files" : "0", "lib" : "0", "perl" : "5.010", "strictures" : "2", "warnings" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Clone" : "0.30", "Digest::MD5" : "2.35", "Exporter" : "0", "File::Path" : "0", "File::Spec" : "0", "List::Util" : "1.33", "Params::Util" : "1.00", "Scalar::Util" : "0", "Storable" : "2.17", "Task::Weaken" : "0", "constant" : "0", "if" : "0", "overload" : "0", "perl" : "5.006", "strict" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "B" : "0", "Class::Inspector" : "1.22", "Encode" : "0", "ExtUtils::MakeMaker" : "0", "File::Copy" : "0", "File::Spec" : "0", "File::Spec::Functions" : "0", "File::Temp" : "0", "Test::More" : "0.96", "Test::NoWarnings" : "0", "Test::Object" : "0.07", "Test::SubCalls" : "1.07", "lib" : "0", "parent" : "0", "utf8" : "0", "warnings" : "0" } } }, "provides" : { "PPI" : { "file" : "lib/PPI.pm", "version" : "1.278" }, "PPI::Cache" : { "file" : "lib/PPI/Cache.pm", "version" : "1.278" }, "PPI::Document" : { "file" : "lib/PPI/Document.pm", "version" : "1.278" }, "PPI::Document::File" : { "file" : "lib/PPI/Document/File.pm", "version" : "1.278" }, "PPI::Document::Fragment" : { "file" : "lib/PPI/Document/Fragment.pm", "version" : "1.278" }, "PPI::Document::Normalized" : { "file" : "lib/PPI/Document/Normalized.pm", "version" : "1.278" }, "PPI::Dumper" : { "file" : "lib/PPI/Dumper.pm", "version" : "1.278" }, "PPI::Element" : { "file" : "lib/PPI/Element.pm", "version" : "1.278" }, "PPI::Exception" : { "file" : "lib/PPI/Exception.pm", "version" : "1.278" }, "PPI::Exception::ParserRejection" : { "file" : "lib/PPI/Exception/ParserRejection.pm", "version" : "1.278" }, "PPI::Find" : { "file" : "lib/PPI/Find.pm", "version" : "1.278" }, "PPI::Lexer" : { "file" : "lib/PPI/Lexer.pm", "version" : "1.278" }, "PPI::Node" : { "file" : "lib/PPI/Node.pm", "version" : "1.278" }, "PPI::Normal" : { "file" : "lib/PPI/Normal.pm", "version" : "1.278" }, "PPI::Normal::Standard" : { "file" : "lib/PPI/Normal/Standard.pm", "version" : "1.278" }, "PPI::Singletons" : { "file" : "lib/PPI/Singletons.pm", "version" : "1.278" }, "PPI::Statement" : { "file" : "lib/PPI/Statement.pm", "version" : "1.278" }, "PPI::Statement::Break" : { "file" : "lib/PPI/Statement/Break.pm", "version" : "1.278" }, "PPI::Statement::Compound" : { "file" : "lib/PPI/Statement/Compound.pm", "version" : "1.278" }, "PPI::Statement::Data" : { "file" : "lib/PPI/Statement/Data.pm", "version" : "1.278" }, "PPI::Statement::End" : { "file" : "lib/PPI/Statement/End.pm", "version" : "1.278" }, "PPI::Statement::Expression" : { "file" : "lib/PPI/Statement/Expression.pm", "version" : "1.278" }, "PPI::Statement::Given" : { "file" : "lib/PPI/Statement/Given.pm", "version" : "1.278" }, "PPI::Statement::Include" : { "file" : "lib/PPI/Statement/Include.pm", "version" : "1.278" }, "PPI::Statement::Include::Perl6" : { "file" : "lib/PPI/Statement/Include/Perl6.pm", "version" : "1.278" }, "PPI::Statement::Null" : { "file" : "lib/PPI/Statement/Null.pm", "version" : "1.278" }, "PPI::Statement::Package" : { "file" : "lib/PPI/Statement/Package.pm", "version" : "1.278" }, "PPI::Statement::Scheduled" : { "file" : "lib/PPI/Statement/Scheduled.pm", "version" : "1.278" }, "PPI::Statement::Sub" : { "file" : "lib/PPI/Statement/Sub.pm", "version" : "1.278" }, "PPI::Statement::Unknown" : { "file" : "lib/PPI/Statement/Unknown.pm", "version" : "1.278" }, "PPI::Statement::UnmatchedBrace" : { "file" : "lib/PPI/Statement/UnmatchedBrace.pm", "version" : "1.278" }, "PPI::Statement::Variable" : { "file" : "lib/PPI/Statement/Variable.pm", "version" : "1.278" }, "PPI::Statement::When" : { "file" : "lib/PPI/Statement/When.pm", "version" : "1.278" }, "PPI::Structure" : { "file" : "lib/PPI/Structure.pm", "version" : "1.278" }, "PPI::Structure::Block" : { "file" : "lib/PPI/Structure/Block.pm", "version" : "1.278" }, "PPI::Structure::Condition" : { "file" : "lib/PPI/Structure/Condition.pm", "version" : "1.278" }, "PPI::Structure::Constructor" : { "file" : "lib/PPI/Structure/Constructor.pm", "version" : "1.278" }, "PPI::Structure::For" : { "file" : "lib/PPI/Structure/For.pm", "version" : "1.278" }, "PPI::Structure::Given" : { "file" : "lib/PPI/Structure/Given.pm", "version" : "1.278" }, "PPI::Structure::List" : { "file" : "lib/PPI/Structure/List.pm", "version" : "1.278" }, "PPI::Structure::Subscript" : { "file" : "lib/PPI/Structure/Subscript.pm", "version" : "1.278" }, "PPI::Structure::Unknown" : { "file" : "lib/PPI/Structure/Unknown.pm", "version" : "1.278" }, "PPI::Structure::When" : { "file" : "lib/PPI/Structure/When.pm", "version" : "1.278" }, "PPI::Token" : { "file" : "lib/PPI/Token.pm", "version" : "1.278" }, "PPI::Token::ArrayIndex" : { "file" : "lib/PPI/Token/ArrayIndex.pm", "version" : "1.278" }, "PPI::Token::Attribute" : { "file" : "lib/PPI/Token/Attribute.pm", "version" : "1.278" }, "PPI::Token::BOM" : { "file" : "lib/PPI/Token/BOM.pm", "version" : "1.278" }, "PPI::Token::Cast" : { "file" : "lib/PPI/Token/Cast.pm", "version" : "1.278" }, "PPI::Token::Comment" : { "file" : "lib/PPI/Token/Comment.pm", "version" : "1.278" }, "PPI::Token::DashedWord" : { "file" : "lib/PPI/Token/DashedWord.pm", "version" : "1.278" }, "PPI::Token::Data" : { "file" : "lib/PPI/Token/Data.pm", "version" : "1.278" }, "PPI::Token::End" : { "file" : "lib/PPI/Token/End.pm", "version" : "1.278" }, "PPI::Token::HereDoc" : { "file" : "lib/PPI/Token/HereDoc.pm", "version" : "1.278" }, "PPI::Token::Label" : { "file" : "lib/PPI/Token/Label.pm", "version" : "1.278" }, "PPI::Token::Magic" : { "file" : "lib/PPI/Token/Magic.pm", "version" : "1.278" }, "PPI::Token::Number" : { "file" : "lib/PPI/Token/Number.pm", "version" : "1.278" }, "PPI::Token::Number::Binary" : { "file" : "lib/PPI/Token/Number/Binary.pm", "version" : "1.278" }, "PPI::Token::Number::Exp" : { "file" : "lib/PPI/Token/Number/Exp.pm", "version" : "1.278" }, "PPI::Token::Number::Float" : { "file" : "lib/PPI/Token/Number/Float.pm", "version" : "1.278" }, "PPI::Token::Number::Hex" : { "file" : "lib/PPI/Token/Number/Hex.pm", "version" : "1.278" }, "PPI::Token::Number::Octal" : { "file" : "lib/PPI/Token/Number/Octal.pm", "version" : "1.278" }, "PPI::Token::Number::Version" : { "file" : "lib/PPI/Token/Number/Version.pm", "version" : "1.278" }, "PPI::Token::Operator" : { "file" : "lib/PPI/Token/Operator.pm", "version" : "1.278" }, "PPI::Token::Pod" : { "file" : "lib/PPI/Token/Pod.pm", "version" : "1.278" }, "PPI::Token::Prototype" : { "file" : "lib/PPI/Token/Prototype.pm", "version" : "1.278" }, "PPI::Token::Quote" : { "file" : "lib/PPI/Token/Quote.pm", "version" : "1.278" }, "PPI::Token::Quote::Double" : { "file" : "lib/PPI/Token/Quote/Double.pm", "version" : "1.278" }, "PPI::Token::Quote::Interpolate" : { "file" : "lib/PPI/Token/Quote/Interpolate.pm", "version" : "1.278" }, "PPI::Token::Quote::Literal" : { "file" : "lib/PPI/Token/Quote/Literal.pm", "version" : "1.278" }, "PPI::Token::Quote::Single" : { "file" : "lib/PPI/Token/Quote/Single.pm", "version" : "1.278" }, "PPI::Token::QuoteLike" : { "file" : "lib/PPI/Token/QuoteLike.pm", "version" : "1.278" }, "PPI::Token::QuoteLike::Backtick" : { "file" : "lib/PPI/Token/QuoteLike/Backtick.pm", "version" : "1.278" }, "PPI::Token::QuoteLike::Command" : { "file" : "lib/PPI/Token/QuoteLike/Command.pm", "version" : "1.278" }, "PPI::Token::QuoteLike::Readline" : { "file" : "lib/PPI/Token/QuoteLike/Readline.pm", "version" : "1.278" }, "PPI::Token::QuoteLike::Regexp" : { "file" : "lib/PPI/Token/QuoteLike/Regexp.pm", "version" : "1.278" }, "PPI::Token::QuoteLike::Words" : { "file" : "lib/PPI/Token/QuoteLike/Words.pm", "version" : "1.278" }, "PPI::Token::Regexp" : { "file" : "lib/PPI/Token/Regexp.pm", "version" : "1.278" }, "PPI::Token::Regexp::Match" : { "file" : "lib/PPI/Token/Regexp/Match.pm", "version" : "1.278" }, "PPI::Token::Regexp::Substitute" : { "file" : "lib/PPI/Token/Regexp/Substitute.pm", "version" : "1.278" }, "PPI::Token::Regexp::Transliterate" : { "file" : "lib/PPI/Token/Regexp/Transliterate.pm", "version" : "1.278" }, "PPI::Token::Separator" : { "file" : "lib/PPI/Token/Separator.pm", "version" : "1.278" }, "PPI::Token::Structure" : { "file" : "lib/PPI/Token/Structure.pm", "version" : "1.278" }, "PPI::Token::Symbol" : { "file" : "lib/PPI/Token/Symbol.pm", "version" : "1.278" }, "PPI::Token::Unknown" : { "file" : "lib/PPI/Token/Unknown.pm", "version" : "1.278" }, "PPI::Token::Whitespace" : { "file" : "lib/PPI/Token/Whitespace.pm", "version" : "1.278" }, "PPI::Token::Word" : { "file" : "lib/PPI/Token/Word.pm", "version" : "1.278" }, "PPI::Tokenizer" : { "file" : "lib/PPI/Tokenizer.pm", "version" : "1.278" }, "PPI::Transform" : { "file" : "lib/PPI/Transform.pm", "version" : "1.278" }, "PPI::Transform::UpdateCopyright" : { "file" : "lib/PPI/Transform/UpdateCopyright.pm", "version" : "1.278" }, "PPI::Util" : { "file" : "lib/PPI/Util.pm", "version" : "1.278" }, "PPI::XSAccessor" : { "file" : "lib/PPI/XSAccessor.pm", "version" : "1.278" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/Perl-Critic/PPI/issues" }, "homepage" : "https://github.com/Perl-Critic/PPI", "repository" : { "url" : "https://github.com/Perl-Critic/PPI" } }, "version" : "1.278", "x_Dist_Zilla" : { "perl" : { "version" : "5.034000" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "MetaResources", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Encoding", "name" : "Encoding", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "AutoPrereqs", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "TestRequires", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::DynamicPrereqs", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "DynamicPrereqs", "version" : "0.040" }, { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "config" : { "Dist::Zilla::Plugin::GatherDir" : { "exclude_filename" : [ "README.pod" ], "exclude_match" : [], "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "Git::GatherDir", "version" : "2.049" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "MetaYAML", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "MetaJSON", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Readme", "name" : "Readme", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "Manifest", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "License", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : "8" } }, "name" : "MakeMaker", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::CPANFile", "name" : "CPANFile", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "bail_out_on_fail" : "1", "fail_on_warning" : "author", "fake_home" : 0, "filename" : "xt/author/00-compile.t", "module_finder" : [ ":InstallModules" ], "needs_display" : 0, "phase" : "develop", "script_finder" : [ ":PerlExecFiles" ], "skips" : [], "switch" : [] } }, "name" : "Test::Compile", "version" : "2.058" }, { "class" : "Dist::Zilla::Plugin::MetaTests", "name" : "MetaTests", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "Test::ChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "PodSyntaxTests", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Test::Pod::No404s", "name" : "Test::Pod::No404s", "version" : "1.004" }, { "class" : "Dist::Zilla::Plugin::Test::Kwalitee", "config" : { "Dist::Zilla::Plugin::Test::Kwalitee" : { "filename" : "xt/author/kwalitee.t", "skiptest" : [] } }, "name" : "Test::Kwalitee", "version" : "2.12" }, { "class" : "Dist::Zilla::Plugin::MojibakeTests", "name" : "MojibakeTests", "version" : "0.8" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "Test::ReportPrereqs", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::Test::Portability", "config" : { "Dist::Zilla::Plugin::Test::Portability" : { "options" : "" } }, "name" : "Test::Portability", "version" : "2.001001" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", "config" : { "Dist::Zilla::Plugin::MetaProvides::Package" : { "finder_objects" : [ { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.031" } ], "include_underscores" : 0 }, "Dist::Zilla::Role::MetaProvider::Provider" : { "$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002004", "inherit_missing" : 1, "inherit_version" : 1, "meta_noindex" : 1 }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "MetaProvides::Package", "version" : "2.004003" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "MetaConfig", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Keywords", "config" : { "Dist::Zilla::Plugin::Keywords" : { "keywords" : [] } }, "name" : "Keywords", "version" : "0.007" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git_version" : "2.34.1", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "Git::Contributors", "version" : "0.036" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : "8" } }, "name" : "RunExtraTests", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." } }, "name" : "initial check", "version" : "2.049" }, { "class" : "Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." } }, "name" : "Git::CheckFor::MergeConflicts", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::Git::CheckFor::CorrectBranch", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." } }, "name" : "Git::CheckFor::CorrectBranch", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "CheckPrereqsIndexed", "version" : "0.022" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "TestRelease", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." } }, "name" : "after tests", "version" : "2.049" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "UploadToCPAN", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "recommends" } }, "name" : "@Git::VersionManager/pluginbundle version", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::RewriteVersion::Transitional", "config" : { "Dist::Zilla::Plugin::RewriteVersion" : { "add_tarball_name" : 0, "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 0, "skip_version_provider" : 0 }, "Dist::Zilla::Plugin::RewriteVersion::Transitional" : {} }, "name" : "@Git::VersionManager/RewriteVersion::Transitional", "version" : "0.009" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Update", "name" : "@Git::VersionManager/MetaProvides::Update", "version" : "0.007" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromRelease", "config" : { "Dist::Zilla::Plugin::CopyFilesFromRelease" : { "filename" : [ "Changes" ], "match" : [] } }, "name" : "@Git::VersionManager/CopyFilesFromRelease", "version" : "0.007" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [ "." ], "commit_msg" : "%N-%v%t%n%n%c", "signoff" : 0 }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Git::VersionManager/release snapshot", "version" : "2.049" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "v1.278", "tag_format" : "v%v", "tag_message" : "v%v%t" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Git::VersionManager/Git::Tag", "version" : "2.049" }, { "class" : "Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional", "config" : { "Dist::Zilla::Plugin::BumpVersionAfterRelease" : { "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 0, "munge_makefile_pl" : 1 }, "Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional" : {} }, "name" : "@Git::VersionManager/BumpVersionAfterRelease::Transitional", "version" : "0.009" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@Git::VersionManager/NextRelease", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "increment $VERSION after %v release", "signoff" : 0 }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Build.PL", "Changes", "Makefile.PL" ], "allow_dirty_match" : [ "(?^:^lib/.*\\.pm$)" ], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@Git::VersionManager/post-release commit", "version" : "2.049" }, { "class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod", "config" : { "Dist::Zilla::Role::FileWatcher" : { "version" : "0.006" } }, "name" : "ReadmeAnyFromPod", "version" : "0.163250" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.34.1", "repo_root" : "." } }, "name" : "Git::Push", "version" : "2.049" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "ConfirmRelease", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.031" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.031" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.031" } }, "x_contributors" : [ "Adam Kennedy ", "Andy Lester ", "Arnout Pierre ", "bowtie ", "Branislav Zahradn\u00edk ", "brian d foy ", "Chas. J. Owens IV ", "Chris Capaci ", "Chris Dolan ", "Christian Walde ", "Christian Walde ", "Colin Newell ", "Damyan Ivanov ", "Dan Book ", "Dan Church ", "David Steinbrunner ", "dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>", "Edmund Adjei ", "Elliot Shank ", "Gabor Szabo ", "Graham Knop ", "Graham Ollis ", "Guillaume Aubert ", "James E Keenan ", "Joel Maslak ", "Julian Fondren ", "Karen Etheridge ", "Kent Fredric ", "Lance Wicks ", "Matt Church ", "Matthew Horsfall ", "Mike O'Regan ", "Milos Kukla ", "Mohammad S Anwar ", "nanto_vi ", "Olaf Alders ", "Olivier Mengu\u00e9 ", "Philippe Bruhat (BooK) ", "Randy Lauen ", "Reini Urban ", "reneeb ", "Shmuel Fomberg ", "Steffen M\u00fcller ", "Szymon Niezna\u0144ski ", "Takumi Akiyama ", "Thomas Sibley ", "Tom Wyant ", "Van de Bugger ", "Will Braswell " ], "x_generated_by_perl" : "v5.34.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.37", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } PPI-1.278/xt/0000775000175000017500000000000014573465137011263 5ustar olafolafPPI-1.278/xt/DepReqs.pm0000644000175000017500000000564014573465137013167 0ustar olafolafpackage # DepReqs; use 5.010; use strictures 2; use Test::DependentModules; use IO::All; use MetaCPAN::Client; use List::Util 'uniqstr'; use Devel::Confess; 1; __PACKAGE__->run unless caller; sub exclusions { qr/^( # don't remember why i excluded these Apache2-SSI|Devel-IPerl|Padre # fails tests regarding directory write permissions, probably not PPI |Devel-Examine-Subs # their dependencies don't even install |Devel-ebug-HTTP|Padre-Plugin-ParserTool|Devel-PerlySense|PPI-Tester |Acme-ReturnValue|Bot-BasicBot-Pluggable-Module-Gitbot|Pinwheel |Dist-Zilla-Plugin-MetaProvides-Package|Dist-Zilla-Plugin-Readme-Brief |Apache2-PPI-HTML # author parsing issue |Spellunker-Perl # takes too long |RPerl # broken on cpan |Acme-VarMess|Module-Checkstyle|MooseX-Documenter|Perl-Achievements |Perl-Metrics|Ravenel|Test-LocalFunctions|UML-Class-Simple # maybe broken on cpan |App-Grepl|App-Midgen|App-PRT|Pod-Weaver-Section-SQL # investigate |Class-Discover|Devel-Decouple|File-PackageIndexer|Perl-Signature |Perl-Squish|Perl-ToPerl6|Test-Declare # RT 76417 |Devel-Graph # meeds Class::Gomor as dep |Metabrik # depends on RPerl |MLPerl # RT 129344 |Module-AnyEvent-Helper )$/x } sub force_big_metacpan_fetch { ## force metacpan to actually return the whole dependents list # https://github.com/metacpan/metacpan-client/issues/122 my $old_fetch = \&MetaCPAN::Client::fetch; my $new_fetch = sub { $old_fetch->( shift, shift . "?size=5000", @_ ) }; { no warnings 'redefine'; *MetaCPAN::Client::fetch = $new_fetch; } return $old_fetch; } sub run { my $old_fetch = force_big_metacpan_fetch; my @deps = Test::DependentModules::_get_deps PPI => { exclude => exclusions() }; { no warnings 'redefine'; *MetaCPAN::Client::fetch = $old_fetch; } my $c = MetaCPAN::Client->new; my @reqs; for my $dependent (@deps) { say $dependent; my @dep_reqs = map @{ $c->release($_)->dependency }, $dependent; say " $_->{module}" for @dep_reqs; push @reqs, @dep_reqs; } say "writing file"; io("xt/cpanfile") ->print( join "\n", uniqstr map qq[requires "$_->{module}" => "$_->{version}";], @reqs ); say "debug printing file"; say io("xt/cpanfile")->all; # test early that all modules don't have an author that crashes tests later # !!! careful, this changes CWD !!! Test::DependentModules::_load_cpan; for my $name (@deps) { my $mod = $name; $mod =~ s/-/::/g; next unless # my $dist = Test::DependentModules::_get_distro($mod); $dist->author->id; } say "done"; } PPI-1.278/xt/author/0000775000175000017500000000000014573465137012565 5ustar olafolafPPI-1.278/xt/author/portability.t0000644000175000017500000000013014573465137015304 0ustar olafolafuse strict; use warnings; use Test::More; use Test::Portability::Files; run_tests(); PPI-1.278/xt/author/distmeta.t0000644000175000017500000000022314573465137014557 0ustar olafolaf#!perl # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use strict; use warnings; use Test::CPAN::Meta; meta_yaml_ok(); PPI-1.278/xt/author/kwalitee.t0000644000175000017500000000027514573465137014561 0ustar olafolaf# this test was generated with Dist::Zilla::Plugin::Test::Kwalitee 2.12 use strict; use warnings; use Test::More 0.88; use Test::Kwalitee 1.21 'kwalitee_ok'; kwalitee_ok(); done_testing; PPI-1.278/xt/author/00-compile.t0000644000175000017500000001007114573465137014614 0ustar olafolafuse 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More 0.94; plan tests => 95; my @module_files = ( 'PPI.pm', 'PPI/Cache.pm', 'PPI/Document.pm', 'PPI/Document/File.pm', 'PPI/Document/Fragment.pm', 'PPI/Document/Normalized.pm', 'PPI/Dumper.pm', 'PPI/Element.pm', 'PPI/Exception.pm', 'PPI/Exception/ParserRejection.pm', 'PPI/Find.pm', 'PPI/Lexer.pm', 'PPI/Node.pm', 'PPI/Normal.pm', 'PPI/Normal/Standard.pm', 'PPI/Singletons.pm', 'PPI/Statement.pm', 'PPI/Statement/Break.pm', 'PPI/Statement/Compound.pm', 'PPI/Statement/Data.pm', 'PPI/Statement/End.pm', 'PPI/Statement/Expression.pm', 'PPI/Statement/Given.pm', 'PPI/Statement/Include.pm', 'PPI/Statement/Include/Perl6.pm', 'PPI/Statement/Null.pm', 'PPI/Statement/Package.pm', 'PPI/Statement/Scheduled.pm', 'PPI/Statement/Sub.pm', 'PPI/Statement/Unknown.pm', 'PPI/Statement/UnmatchedBrace.pm', 'PPI/Statement/Variable.pm', 'PPI/Statement/When.pm', 'PPI/Structure.pm', 'PPI/Structure/Block.pm', 'PPI/Structure/Condition.pm', 'PPI/Structure/Constructor.pm', 'PPI/Structure/For.pm', 'PPI/Structure/Given.pm', 'PPI/Structure/List.pm', 'PPI/Structure/Subscript.pm', 'PPI/Structure/Unknown.pm', 'PPI/Structure/When.pm', 'PPI/Token.pm', 'PPI/Token/ArrayIndex.pm', 'PPI/Token/Attribute.pm', 'PPI/Token/BOM.pm', 'PPI/Token/Cast.pm', 'PPI/Token/Comment.pm', 'PPI/Token/DashedWord.pm', 'PPI/Token/Data.pm', 'PPI/Token/End.pm', 'PPI/Token/HereDoc.pm', 'PPI/Token/Label.pm', 'PPI/Token/Magic.pm', 'PPI/Token/Number.pm', 'PPI/Token/Number/Binary.pm', 'PPI/Token/Number/Exp.pm', 'PPI/Token/Number/Float.pm', 'PPI/Token/Number/Hex.pm', 'PPI/Token/Number/Octal.pm', 'PPI/Token/Number/Version.pm', 'PPI/Token/Operator.pm', 'PPI/Token/Pod.pm', 'PPI/Token/Prototype.pm', 'PPI/Token/Quote.pm', 'PPI/Token/Quote/Double.pm', 'PPI/Token/Quote/Interpolate.pm', 'PPI/Token/Quote/Literal.pm', 'PPI/Token/Quote/Single.pm', 'PPI/Token/QuoteLike.pm', 'PPI/Token/QuoteLike/Backtick.pm', 'PPI/Token/QuoteLike/Command.pm', 'PPI/Token/QuoteLike/Readline.pm', 'PPI/Token/QuoteLike/Regexp.pm', 'PPI/Token/QuoteLike/Words.pm', 'PPI/Token/Regexp.pm', 'PPI/Token/Regexp/Match.pm', 'PPI/Token/Regexp/Substitute.pm', 'PPI/Token/Regexp/Transliterate.pm', 'PPI/Token/Separator.pm', 'PPI/Token/Structure.pm', 'PPI/Token/Symbol.pm', 'PPI/Token/Unknown.pm', 'PPI/Token/Whitespace.pm', 'PPI/Token/Word.pm', 'PPI/Token/_QuoteEngine.pm', 'PPI/Token/_QuoteEngine/Full.pm', 'PPI/Token/_QuoteEngine/Simple.pm', 'PPI/Tokenizer.pm', 'PPI/Transform.pm', 'PPI/Transform/UpdateCopyright.pm', 'PPI/Util.pm', 'PPI/XSAccessor.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', explain(\@warnings); BAIL_OUT("Compilation problems") if !Test::More->builder->is_passing; PPI-1.278/xt/author/pod-syntax.t0000644000175000017500000000025214573465137015055 0ustar olafolaf#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); PPI-1.278/xt/author/pod-no404s.t0000644000175000017500000000052714573465137014563 0ustar olafolaf#!perl use strict; use warnings; use Test::More; foreach my $env_skip ( qw( SKIP_POD_NO404S AUTOMATED_TESTING ) ){ plan skip_all => "\$ENV{$env_skip} is set, skipping" if $ENV{$env_skip}; } eval "use Test::Pod::No404s"; if ( $@ ) { plan skip_all => 'Test::Pod::No404s required for testing POD'; } else { all_pod_files_ok(); } PPI-1.278/xt/author/mojibake.t0000644000175000017500000000015114573465137014526 0ustar olafolaf#!perl use strict; use warnings qw(all); use Test::More; use Test::Mojibake; all_files_encoding_ok(); PPI-1.278/xt/dependent-modules.t0000644000175000017500000000163314573465137015065 0ustar olafolafuse Test2::V0; use strictures 2; use Test::DependentModules 'test_all_dependents'; use MetaCPAN::Client; use Devel::Confess; use lib '.'; require( -e "xt" ? "xt/DepReqs.pm" : "DepReqs.pm" ); skip_all "ENV var TEST_DEPENDENTS not set" if not $ENV{TEST_DEPENDENTS}; # duplicate error output into an array for later printing my @error_log; my $old_log = \&Test::DependentModules::_error_log; my $new_log = sub { push @error_log, @_; $old_log->(@_); }; { no warnings 'redefine'; *Test::DependentModules::_error_log = $new_log; } DepReqs::force_big_metacpan_fetch(); test_all_dependents PPI => { exclude => DepReqs::exclusions() }; my $error_log = join "\n", @error_log; my $fails = join "\n", $error_log =~ /(FAIL: .*\w+)$/mg; diag "\n\n---------- ERROR LOG START -----------\n\n", @error_log, "\n\n---------- FAILS: -----------\n\n", $fails, "\n\n---------- ERROR LOG END -----------\n\n"; done_testing; PPI-1.278/xt/release/0000775000175000017500000000000014573465137012703 5ustar olafolafPPI-1.278/xt/release/changes_has_content.t0000644000175000017500000000210114573465137017055 0ustar olafolafuse Test::More tests => 2; note 'Checking Changes'; my $changes_file = 'Changes'; my $newver = '1.278'; my $trial_token = '-TRIAL'; my $encoding = 'UTF-8'; SKIP: { ok(-e $changes_file, "$changes_file file exists") or skip 'Changes is missing', 1; ok(_get_changes($newver), "$changes_file has content for $newver"); } done_testing; sub _get_changes { my $newver = shift; # parse changelog to find commit message open(my $fh, '<', $changes_file) or die "cannot open $changes_file: $!"; my $changelog = join('', <$fh>); if ($encoding) { require Encode; $changelog = Encode::decode($encoding, $changelog, Encode::FB_CROAK()); } close $fh; my @content = grep { /^$newver(?:$trial_token)?(?:\s+|$)/ ... /^\S/ } # from newver to un-indented split /\n/, $changelog; shift @content; # drop the version line # drop unindented last line and trailing blank lines pop @content while ( @content && $content[-1] =~ /^(?:\S|\s*$)/ ); # return number of non-blank lines return scalar @content; } PPI-1.278/xt/author.t0000644000175000017500000000076714573465137012762 0ustar olafolaf#!/usr/bin/perl use strict; BEGIN { $| = 1; $^W = 1; } my $MODULE = 'Test::Pod 1.44'; # Don't run tests for installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing module if ( !eval "use $MODULE; 1" ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } all_pod_files_ok(); PPI-1.278/xt/api.t0000644000175000017500000001700014573465137012215 0ustar olafolaf#!/usr/bin/perl # Basic first pass API testing for PPI use lib 't/lib'; use PPI::Test::pragmas; use Test::More; BEGIN { my $tests = 2935 + ($ENV{AUTHOR_TESTING} ? 1 : 0); if ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( tests => $tests ); } else { plan( skip_all => 'Author tests not required for installation' ); } } use Test::ClassAPI; use PPI; use PPI::Dumper; use PPI::Find; use PPI::Transform; # Ignore various imported or special functions $Test::ClassAPI::IGNORE{'DESTROY'}++; $Test::ClassAPI::IGNORE{'refaddr'}++; $Test::ClassAPI::IGNORE{'reftype'}++; $Test::ClassAPI::IGNORE{'blessed'}++; # Execute the tests Test::ClassAPI->execute('complete', 'collisions'); exit(0); # Now, define the API for the classes __DATA__ # Explicitly list the core classes PPI=class PPI::Tokenizer=class PPI::Lexer=class PPI::Dumper=class PPI::Find=class PPI::Transform=abstract PPI::Normal=class # The abstract PDOM classes PPI::Element=abstract PPI::Node=abstract PPI::Token=abstract PPI::Token::_QuoteEngine=abstract PPI::Token::_QuoteEngine::Simple=abstract PPI::Token::_QuoteEngine::Full=abstract PPI::Token::Quote=abstract PPI::Token::QuoteLike=abstract PPI::Token::Regexp=abstract PPI::Structure=abstract PPI::Statement=abstract ##################################################################### # PDOM Classes [PPI::Element] new=method clone=method parent=method descendant_of=method ancestor_of=method top=method document=method statement=method next_sibling=method snext_sibling=method previous_sibling=method sprevious_sibling=method first_token=method last_token=method next_token=method previous_token=method insert_before=method insert_after=method remove=method delete=method replace=method content=method tokens=method significant=method location=method line_number=method column_number=method visual_column_number=method logical_line_number=method logical_filename=method class=method [PPI::Node] PPI::Element=isa scope=method add_element=method elements=method first_element=method last_element=method children=method schildren=method child=method schild=method contains=method find=method find_any=method find_first=method remove_child=method prune=method [PPI::Token] PPI::Element=isa new=method add_content=method set_class=method set_content=method length=method [PPI::Token::Whitespace] PPI::Token=isa null=method tidy=method [PPI::Token::Pod] PPI::Token=isa lines=method merge=method [PPI::Token::Data] PPI::Token=isa handle=method [PPI::Token::End] PPI::Token=isa [PPI::Token::Comment] PPI::Token=isa line=method [PPI::Token::Word] PPI::Token=isa literal=method method_call=method [PPI::Token::Separator] PPI::Token::Word=isa [PPI::Token::Label] PPI::Token=isa [PPI::Token::Structure] PPI::Token=isa [PPI::Token::Number] PPI::Token=isa base=method literal=method [PPI::Token::Symbol] PPI::Token=isa canonical=method symbol=method raw_type=method symbol_type=method [PPI::Token::ArrayIndex] PPI::Token=isa [PPI::Token::Operator] PPI::Token=isa [PPI::Token::Magic] PPI::Token=isa PPI::Token::Symbol=isa [PPI::Token::Cast] PPI::Token=isa [PPI::Token::Prototype] PPI::Token=isa prototype=method [PPI::Token::Attribute] PPI::Token=isa identifier=method parameters=method [PPI::Token::DashedWord] PPI::Token=isa literal=method [PPI::Token::HereDoc] PPI::Token=isa heredoc=method terminator=method [PPI::Token::_QuoteEngine] [PPI::Token::_QuoteEngine::Simple] PPI::Token::_QuoteEngine=isa [PPI::Token::_QuoteEngine::Full] PPI::Token::_QuoteEngine=isa [PPI::Token::Quote] PPI::Token=isa string=method [PPI::Token::Quote::Single] PPI::Token=isa PPI::Token::Quote=isa literal=method [PPI::Token::Quote::Double] PPI::Token=isa PPI::Token::Quote=isa interpolations=method simplify=method [PPI::Token::Quote::Literal] PPI::Token=isa literal=method [PPI::Token::Quote::Interpolate] PPI::Token=isa [PPI::Token::QuoteLike] PPI::Token=isa [PPI::Token::QuoteLike::Backtick] PPI::Token=isa PPI::Token::_QuoteEngine::Simple=isa [PPI::Token::QuoteLike::Command] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa [PPI::Token::QuoteLike::Words] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa literal=method [PPI::Token::QuoteLike::Regexp] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa get_match_string=method get_substitute_string=method get_modifiers=method get_delimiters=method [PPI::Token::QuoteLike::Readline] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa [PPI::Token::Regexp] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa get_match_string=method get_substitute_string=method get_modifiers=method get_delimiters=method [PPI::Token::Regexp::Match] PPI::Token=isa [PPI::Token::Regexp::Substitute] PPI::Token=isa [PPI::Token::Regexp::Transliterate] PPI::Token=isa [PPI::Statement] PPI::Node=isa label=method specialized=method stable=method [PPI::Statement::Expression] PPI::Statement=isa [PPI::Statement::Package] PPI::Statement=isa namespace=method version=method file_scoped=method [PPI::Statement::Include] PPI::Statement=isa type=method arguments=method module=method module_version=method pragma=method version=method version_literal=method [PPI::Statement::Include::Perl6] PPI::Statement::Include=isa perl6=method [PPI::Statement::Sub] PPI::Statement=isa name=method prototype=method block=method forward=method reserved=method type=method [PPI::Statement::Scheduled] PPI::Statement::Sub=isa PPI::Statement=isa type=method block=method [PPI::Statement::Variable] PPI::Statement=isa PPI::Statement::Expression=isa type=method variables=method symbols=method [PPI::Statement::Compound] PPI::Statement=isa type=method [PPI::Statement::Given] PPI::Statement=isa [PPI::Statement::When] PPI::Statement=isa [PPI::Statement::Break] PPI::Statement=isa [PPI::Statement::Null] PPI::Statement=isa [PPI::Statement::Data] PPI::Statement=isa [PPI::Statement::End] PPI::Statement=isa [PPI::Statement::Unknown] PPI::Statement=isa [PPI::Structure] PPI::Node=isa braces=method complete=method start=method finish=method [PPI::Structure::Block] PPI::Structure=isa [PPI::Structure::Subscript] PPI::Structure=isa [PPI::Structure::Constructor] PPI::Structure=isa [PPI::Structure::Condition] PPI::Structure=isa [PPI::Structure::List] PPI::Structure=isa [PPI::Structure::For] PPI::Structure=isa [PPI::Structure::Given] PPI::Structure=isa [PPI::Structure::When] PPI::Structure=isa [PPI::Structure::Unknown] PPI::Structure=isa [PPI::Document] PPI::Node=isa get_cache=method set_cache=method load=method save=method readonly=method tab_width=method serialize=method hex_id=method index_locations=method flush_locations=method normalized=method complete=method errstr=method filename=method STORABLE_freeze=method STORABLE_thaw=method [PPI::Document::Fragment] PPI::Document=isa ##################################################################### # Non-PDOM Classes [PPI] [PPI::Tokenizer] new=method get_token=method all_tokens=method increment_cursor=method decrement_cursor=method [PPI::Lexer] new=method lex_file=method lex_source=method lex_tokenizer=method errstr=method [PPI::Dumper] new=method print=method string=method list=method [PPI::Find] new=method clone=method in=method start=method match=method finish=method errstr=method [PPI::Transform] new=method document=method apply=method file=method [PPI::Normal] register=method new=method layer=method process=method [PPI::Normal::Standard] import=method remove_insignificant_elements=method remove_useless_attributes=method remove_useless_pragma=method remove_statement_separator=method remove_useless_return=method [PPI::Document::Normalized] new=method version=method functions=method equal=method PPI-1.278/xt/meta.t0000644000175000017500000000107314573465137012375 0ustar olafolaf#!/usr/bin/perl # Test that our META.yml file matches the current specification. use strict; BEGIN { $| = 1; $^W = 1; } my $MODULE = 'Test::CPAN::Meta 0.17'; # Don't run tests for installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing module if ( !eval "use $MODULE; 1" ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } meta_yaml_ok(); PPI-1.278/xt/pmv.t0000644000175000017500000000163614573465137012256 0ustar olafolaf#!/usr/bin/perl # Test that our declared minimum Perl version matches our syntax use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'File::Find::Rule 0.32', 'File::Find::Rule::Perl 1.09', 'Perl::MinimumVersion 1.25', 'Test::MinimumVersion 0.101080', ); # Don't run tests for installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing modules foreach my $MODULE ( @MODULES ) { if ( !eval "use $MODULE; 1" ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } all_minimum_version_from_metayml_ok( { paths => [ grep { ! /14_charsets/ and ! /24_v6/ } File::Find::Rule->perl_file->in('.') ], } ); PPI-1.278/META.yml0000644000175000017500000005501114573465137012101 0ustar olafolaf--- abstract: 'Parse, Analyze and Manipulate Perl (without perl)' author: - 'Adam Kennedy ' build_requires: B: '0' Class::Inspector: '1.22' Encode: '0' ExtUtils::MakeMaker: '0' File::Copy: '0' File::Spec: '0' File::Spec::Functions: '0' File::Temp: '0' Test::More: '0.96' Test::NoWarnings: '0' Test::Object: '0.07' Test::SubCalls: '1.07' lib: '0' parent: '0' utf8: '0' warnings: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.031, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PPI provides: PPI: file: lib/PPI.pm version: '1.278' PPI::Cache: file: lib/PPI/Cache.pm version: '1.278' PPI::Document: file: lib/PPI/Document.pm version: '1.278' PPI::Document::File: file: lib/PPI/Document/File.pm version: '1.278' PPI::Document::Fragment: file: lib/PPI/Document/Fragment.pm version: '1.278' PPI::Document::Normalized: file: lib/PPI/Document/Normalized.pm version: '1.278' PPI::Dumper: file: lib/PPI/Dumper.pm version: '1.278' PPI::Element: file: lib/PPI/Element.pm version: '1.278' PPI::Exception: file: lib/PPI/Exception.pm version: '1.278' PPI::Exception::ParserRejection: file: lib/PPI/Exception/ParserRejection.pm version: '1.278' PPI::Find: file: lib/PPI/Find.pm version: '1.278' PPI::Lexer: file: lib/PPI/Lexer.pm version: '1.278' PPI::Node: file: lib/PPI/Node.pm version: '1.278' PPI::Normal: file: lib/PPI/Normal.pm version: '1.278' PPI::Normal::Standard: file: lib/PPI/Normal/Standard.pm version: '1.278' PPI::Singletons: file: lib/PPI/Singletons.pm version: '1.278' PPI::Statement: file: lib/PPI/Statement.pm version: '1.278' PPI::Statement::Break: file: lib/PPI/Statement/Break.pm version: '1.278' PPI::Statement::Compound: file: lib/PPI/Statement/Compound.pm version: '1.278' PPI::Statement::Data: file: lib/PPI/Statement/Data.pm version: '1.278' PPI::Statement::End: file: lib/PPI/Statement/End.pm version: '1.278' PPI::Statement::Expression: file: lib/PPI/Statement/Expression.pm version: '1.278' PPI::Statement::Given: file: lib/PPI/Statement/Given.pm version: '1.278' PPI::Statement::Include: file: lib/PPI/Statement/Include.pm version: '1.278' PPI::Statement::Include::Perl6: file: lib/PPI/Statement/Include/Perl6.pm version: '1.278' PPI::Statement::Null: file: lib/PPI/Statement/Null.pm version: '1.278' PPI::Statement::Package: file: lib/PPI/Statement/Package.pm version: '1.278' PPI::Statement::Scheduled: file: lib/PPI/Statement/Scheduled.pm version: '1.278' PPI::Statement::Sub: file: lib/PPI/Statement/Sub.pm version: '1.278' PPI::Statement::Unknown: file: lib/PPI/Statement/Unknown.pm version: '1.278' PPI::Statement::UnmatchedBrace: file: lib/PPI/Statement/UnmatchedBrace.pm version: '1.278' PPI::Statement::Variable: file: lib/PPI/Statement/Variable.pm version: '1.278' PPI::Statement::When: file: lib/PPI/Statement/When.pm version: '1.278' PPI::Structure: file: lib/PPI/Structure.pm version: '1.278' PPI::Structure::Block: file: lib/PPI/Structure/Block.pm version: '1.278' PPI::Structure::Condition: file: lib/PPI/Structure/Condition.pm version: '1.278' PPI::Structure::Constructor: file: lib/PPI/Structure/Constructor.pm version: '1.278' PPI::Structure::For: file: lib/PPI/Structure/For.pm version: '1.278' PPI::Structure::Given: file: lib/PPI/Structure/Given.pm version: '1.278' PPI::Structure::List: file: lib/PPI/Structure/List.pm version: '1.278' PPI::Structure::Subscript: file: lib/PPI/Structure/Subscript.pm version: '1.278' PPI::Structure::Unknown: file: lib/PPI/Structure/Unknown.pm version: '1.278' PPI::Structure::When: file: lib/PPI/Structure/When.pm version: '1.278' PPI::Token: file: lib/PPI/Token.pm version: '1.278' PPI::Token::ArrayIndex: file: lib/PPI/Token/ArrayIndex.pm version: '1.278' PPI::Token::Attribute: file: lib/PPI/Token/Attribute.pm version: '1.278' PPI::Token::BOM: file: lib/PPI/Token/BOM.pm version: '1.278' PPI::Token::Cast: file: lib/PPI/Token/Cast.pm version: '1.278' PPI::Token::Comment: file: lib/PPI/Token/Comment.pm version: '1.278' PPI::Token::DashedWord: file: lib/PPI/Token/DashedWord.pm version: '1.278' PPI::Token::Data: file: lib/PPI/Token/Data.pm version: '1.278' PPI::Token::End: file: lib/PPI/Token/End.pm version: '1.278' PPI::Token::HereDoc: file: lib/PPI/Token/HereDoc.pm version: '1.278' PPI::Token::Label: file: lib/PPI/Token/Label.pm version: '1.278' PPI::Token::Magic: file: lib/PPI/Token/Magic.pm version: '1.278' PPI::Token::Number: file: lib/PPI/Token/Number.pm version: '1.278' PPI::Token::Number::Binary: file: lib/PPI/Token/Number/Binary.pm version: '1.278' PPI::Token::Number::Exp: file: lib/PPI/Token/Number/Exp.pm version: '1.278' PPI::Token::Number::Float: file: lib/PPI/Token/Number/Float.pm version: '1.278' PPI::Token::Number::Hex: file: lib/PPI/Token/Number/Hex.pm version: '1.278' PPI::Token::Number::Octal: file: lib/PPI/Token/Number/Octal.pm version: '1.278' PPI::Token::Number::Version: file: lib/PPI/Token/Number/Version.pm version: '1.278' PPI::Token::Operator: file: lib/PPI/Token/Operator.pm version: '1.278' PPI::Token::Pod: file: lib/PPI/Token/Pod.pm version: '1.278' PPI::Token::Prototype: file: lib/PPI/Token/Prototype.pm version: '1.278' PPI::Token::Quote: file: lib/PPI/Token/Quote.pm version: '1.278' PPI::Token::Quote::Double: file: lib/PPI/Token/Quote/Double.pm version: '1.278' PPI::Token::Quote::Interpolate: file: lib/PPI/Token/Quote/Interpolate.pm version: '1.278' PPI::Token::Quote::Literal: file: lib/PPI/Token/Quote/Literal.pm version: '1.278' PPI::Token::Quote::Single: file: lib/PPI/Token/Quote/Single.pm version: '1.278' PPI::Token::QuoteLike: file: lib/PPI/Token/QuoteLike.pm version: '1.278' PPI::Token::QuoteLike::Backtick: file: lib/PPI/Token/QuoteLike/Backtick.pm version: '1.278' PPI::Token::QuoteLike::Command: file: lib/PPI/Token/QuoteLike/Command.pm version: '1.278' PPI::Token::QuoteLike::Readline: file: lib/PPI/Token/QuoteLike/Readline.pm version: '1.278' PPI::Token::QuoteLike::Regexp: file: lib/PPI/Token/QuoteLike/Regexp.pm version: '1.278' PPI::Token::QuoteLike::Words: file: lib/PPI/Token/QuoteLike/Words.pm version: '1.278' PPI::Token::Regexp: file: lib/PPI/Token/Regexp.pm version: '1.278' PPI::Token::Regexp::Match: file: lib/PPI/Token/Regexp/Match.pm version: '1.278' PPI::Token::Regexp::Substitute: file: lib/PPI/Token/Regexp/Substitute.pm version: '1.278' PPI::Token::Regexp::Transliterate: file: lib/PPI/Token/Regexp/Transliterate.pm version: '1.278' PPI::Token::Separator: file: lib/PPI/Token/Separator.pm version: '1.278' PPI::Token::Structure: file: lib/PPI/Token/Structure.pm version: '1.278' PPI::Token::Symbol: file: lib/PPI/Token/Symbol.pm version: '1.278' PPI::Token::Unknown: file: lib/PPI/Token/Unknown.pm version: '1.278' PPI::Token::Whitespace: file: lib/PPI/Token/Whitespace.pm version: '1.278' PPI::Token::Word: file: lib/PPI/Token/Word.pm version: '1.278' PPI::Tokenizer: file: lib/PPI/Tokenizer.pm version: '1.278' PPI::Transform: file: lib/PPI/Transform.pm version: '1.278' PPI::Transform::UpdateCopyright: file: lib/PPI/Transform/UpdateCopyright.pm version: '1.278' PPI::Util: file: lib/PPI/Util.pm version: '1.278' PPI::XSAccessor: file: lib/PPI/XSAccessor.pm version: '1.278' requires: Carp: '0' Clone: '0.30' Digest::MD5: '2.35' Exporter: '0' File::Path: '0' File::Spec: '0' List::Util: '1.33' Params::Util: '1.00' Scalar::Util: '0' Storable: '2.17' Task::Weaken: '0' constant: '0' if: '0' overload: '0' perl: '5.006' strict: '0' resources: bugtracker: https://github.com/Perl-Critic/PPI/issues homepage: https://github.com/Perl-Critic/PPI repository: https://github.com/Perl-Critic/PPI version: '1.278' x_Dist_Zilla: perl: version: '5.034000' plugins: - class: Dist::Zilla::Plugin::MetaResources name: MetaResources version: '6.031' - class: Dist::Zilla::Plugin::Encoding name: Encoding version: '6.031' - class: Dist::Zilla::Plugin::AutoPrereqs name: AutoPrereqs version: '6.031' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: '6.031' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: TestRequires version: '6.031' - class: Dist::Zilla::Plugin::DynamicPrereqs config: Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: DynamicPrereqs version: '0.040' - class: Dist::Zilla::Plugin::Git::GatherDir config: Dist::Zilla::Plugin::GatherDir: exclude_filename: - README.pod exclude_match: [] include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: Git::GatherDir version: '2.049' - class: Dist::Zilla::Plugin::MetaYAML name: MetaYAML version: '6.031' - class: Dist::Zilla::Plugin::MetaJSON name: MetaJSON version: '6.031' - class: Dist::Zilla::Plugin::Readme name: Readme version: '6.031' - class: Dist::Zilla::Plugin::Manifest name: Manifest version: '6.031' - class: Dist::Zilla::Plugin::License name: License version: '6.031' - class: Dist::Zilla::Plugin::MakeMaker config: Dist::Zilla::Role::TestRunner: default_jobs: '8' name: MakeMaker version: '6.031' - class: Dist::Zilla::Plugin::CPANFile name: CPANFile version: '6.031' - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: bail_out_on_fail: '1' fail_on_warning: author fake_home: 0 filename: xt/author/00-compile.t module_finder: - ':InstallModules' needs_display: 0 phase: develop script_finder: - ':PerlExecFiles' skips: [] switch: [] name: Test::Compile version: '2.058' - class: Dist::Zilla::Plugin::MetaTests name: MetaTests version: '6.031' - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: Test::ChangesHasContent version: '0.011' - class: Dist::Zilla::Plugin::PodSyntaxTests name: PodSyntaxTests version: '6.031' - class: Dist::Zilla::Plugin::Test::Pod::No404s name: Test::Pod::No404s version: '1.004' - class: Dist::Zilla::Plugin::Test::Kwalitee config: Dist::Zilla::Plugin::Test::Kwalitee: filename: xt/author/kwalitee.t skiptest: [] name: Test::Kwalitee version: '2.12' - class: Dist::Zilla::Plugin::MojibakeTests name: MojibakeTests version: '0.8' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: Test::ReportPrereqs version: '0.029' - class: Dist::Zilla::Plugin::Test::Portability config: Dist::Zilla::Plugin::Test::Portability: options: '' name: Test::Portability version: '2.001001' - class: Dist::Zilla::Plugin::MetaProvides::Package config: Dist::Zilla::Plugin::MetaProvides::Package: finder_objects: - class: Dist::Zilla::Plugin::FinderCode name: MetaProvides::Package/AUTOVIV/:InstallModulesPM version: '6.031' include_underscores: 0 Dist::Zilla::Role::MetaProvider::Provider: $Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.002004' inherit_missing: '1' inherit_version: '1' meta_noindex: '1' Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: MetaProvides::Package version: '2.004003' - class: Dist::Zilla::Plugin::MetaConfig name: MetaConfig version: '6.031' - class: Dist::Zilla::Plugin::Keywords config: Dist::Zilla::Plugin::Keywords: keywords: [] name: Keywords version: '0.007' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: git_version: 2.34.1 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: Git::Contributors version: '0.036' - class: Dist::Zilla::Plugin::RunExtraTests config: Dist::Zilla::Role::TestRunner: default_jobs: '8' name: RunExtraTests version: '0.029' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . name: 'initial check' version: '2.049' - class: Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts config: Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . name: Git::CheckFor::MergeConflicts version: '0.014' - class: Dist::Zilla::Plugin::Git::CheckFor::CorrectBranch config: Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . name: Git::CheckFor::CorrectBranch version: '0.014' - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: CheckPrereqsIndexed version: '0.022' - class: Dist::Zilla::Plugin::TestRelease name: TestRelease version: '6.031' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . name: 'after tests' version: '2.049' - class: Dist::Zilla::Plugin::UploadToCPAN name: UploadToCPAN version: '6.031' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: recommends name: '@Git::VersionManager/pluginbundle version' version: '6.031' - class: Dist::Zilla::Plugin::RewriteVersion::Transitional config: Dist::Zilla::Plugin::RewriteVersion: add_tarball_name: 0 finders: - ':ExecFiles' - ':InstallModules' global: 0 skip_version_provider: 0 Dist::Zilla::Plugin::RewriteVersion::Transitional: {} name: '@Git::VersionManager/RewriteVersion::Transitional' version: '0.009' - class: Dist::Zilla::Plugin::MetaProvides::Update name: '@Git::VersionManager/MetaProvides::Update' version: '0.007' - class: Dist::Zilla::Plugin::CopyFilesFromRelease config: Dist::Zilla::Plugin::CopyFilesFromRelease: filename: - Changes match: [] name: '@Git::VersionManager/CopyFilesFromRelease' version: '0.007' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: - . commit_msg: '%N-%v%t%n%n%c' signoff: '0' Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Git::VersionManager/release snapshot' version: '2.049' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: v1.278 tag_format: v%v tag_message: v%v%t Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Git::VersionManager/Git::Tag' version: '2.049' - class: Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional config: Dist::Zilla::Plugin::BumpVersionAfterRelease: finders: - ':ExecFiles' - ':InstallModules' global: 0 munge_makefile_pl: 1 Dist::Zilla::Plugin::BumpVersionAfterRelease::Transitional: {} name: '@Git::VersionManager/BumpVersionAfterRelease::Transitional' version: '0.009' - class: Dist::Zilla::Plugin::NextRelease name: '@Git::VersionManager/NextRelease' version: '6.031' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: 'increment $VERSION after %v release' signoff: '0' Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Build.PL - Changes - Makefile.PL allow_dirty_match: - (?^:^lib/.*\.pm$) changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Git::VersionManager/post-release commit' version: '2.049' - class: Dist::Zilla::Plugin::ReadmeAnyFromPod config: Dist::Zilla::Role::FileWatcher: version: '0.006' name: ReadmeAnyFromPod version: '0.163250' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: git_version: 2.34.1 repo_root: . name: Git::Push version: '2.049' - class: Dist::Zilla::Plugin::ConfirmRelease name: ConfirmRelease version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.031' - class: Dist::Zilla::Plugin::FinderCode name: MetaProvides::Package/AUTOVIV/:InstallModulesPM version: '6.031' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: '0' version: '6.031' x_contributors: - 'Adam Kennedy ' - 'Andy Lester ' - 'Arnout Pierre ' - 'bowtie ' - 'Branislav Zahradník ' - 'brian d foy ' - 'Chas. J. Owens IV ' - 'Chris Capaci ' - 'Chris Dolan ' - 'Christian Walde ' - 'Christian Walde ' - 'Colin Newell ' - 'Damyan Ivanov ' - 'Dan Book ' - 'Dan Church ' - 'David Steinbrunner ' - 'dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>' - 'Edmund Adjei ' - 'Elliot Shank ' - 'Gabor Szabo ' - 'Graham Knop ' - 'Graham Ollis ' - 'Guillaume Aubert ' - 'James E Keenan ' - 'Joel Maslak ' - 'Julian Fondren ' - 'Karen Etheridge ' - 'Kent Fredric ' - 'Lance Wicks ' - 'Matt Church ' - 'Matthew Horsfall ' - "Mike O'Regan " - 'Milos Kukla ' - 'Mohammad S Anwar ' - 'nanto_vi ' - 'Olaf Alders ' - 'Olivier Mengué ' - 'Philippe Bruhat (BooK) ' - 'Randy Lauen ' - 'Reini Urban ' - 'reneeb ' - 'Shmuel Fomberg ' - 'Steffen Müller ' - 'Szymon Nieznański ' - 'Takumi Akiyama ' - 'Thomas Sibley ' - 'Tom Wyant ' - 'Van de Bugger ' - 'Will Braswell ' x_generated_by_perl: v5.34.0 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' PPI-1.278/lib/0000775000175000017500000000000014573465137011376 5ustar olafolafPPI-1.278/lib/PPI.pm0000644000175000017500000007301114573465137012364 0ustar olafolafpackage PPI; # See POD at end for documentation use 5.006; use strict; # Set the version for CPAN our $VERSION = '1.278'; our ( $XS_COMPATIBLE, @XS_EXCLUDE ) = ( '0.845' ); # Load everything use PPI::Util (); use PPI::Exception (); use PPI::Element (); use PPI::Token (); use PPI::Statement (); use PPI::Structure (); use PPI::Document (); use PPI::Document::File (); use PPI::Document::Fragment (); use PPI::Document::Normalized (); use PPI::Normal (); use PPI::Tokenizer (); use PPI::Lexer (); # If it is installed, load in PPI::XS die if !$PPI::XS_DISABLE and !eval { require PPI::XS; 1 } and $@ !~ /^Can't locate .*? at /; # ignore failure to load if not installed 1; __END__ =pod =head1 NAME PPI - Parse, Analyze and Manipulate Perl (without perl) =head1 SYNOPSIS use PPI; # Create a new empty document my $Document = PPI::Document->new; # Create a document from source $Document = PPI::Document->new(\'print "Hello World!\n"'); # Load a Document from a file $Document = PPI::Document->new('Module.pm'); # Does it contain any POD? if ( $Document->find_any('PPI::Token::Pod') ) { print "Module contains POD\n"; } # Get the name of the main package $pkg = $Document->find_first('PPI::Statement::Package')->namespace; # Remove all that nasty documentation $Document->prune('PPI::Token::Pod'); $Document->prune('PPI::Token::Comment'); # Save the file $Document->save('Module.pm.stripped'); =head1 DESCRIPTION =head2 About this Document This is the PPI manual. It describes its reason for existing, its general structure, its use, an overview of the API, and provides a few implementation samples. =head2 Background The ability to read, and manipulate Perl (the language) programmatically other than with perl (the application) was one that caused difficulty for a long time. The cause of this problem was Perl's complex and dynamic grammar. Although there is typically not a huge diversity in the grammar of most Perl code, certain issues cause large problems when it comes to parsing. Indeed, quite early in Perl's history Tom Christiansen introduced the Perl community to the quote I<"Nothing but perl can parse Perl">, or as it is more often stated now as a truism: B<"Only perl can parse Perl"> One example of the sorts of things that prevent Perl from being easily parsed is function signatures, as demonstrated by the following. @result = (dothis $foo, $bar); # Which of the following is it equivalent to? @result = (dothis($foo), $bar); @result = dothis($foo, $bar); The first line above can be interpreted in two different ways, depending on whether the C<&dothis> function is expecting one argument, or two, or several. A "code parser" (something that parses for the purpose of execution) such as perl needs information that is not found in the immediate vicinity of the statement being parsed. The information might not just be elsewhere in the file, it might not even be in the same file at all. It might also not be able to determine this information without the prior execution of a C block, or the loading and execution of one or more external modules. Or worse the C<&dothis> function may not even have been written yet. B Even perl itself never really fully understands the structure of the source code after and indeed B it processes it, and in that sense doesn't "parse" Perl source into anything remotely like a structured document. This makes it of no real use for any task that needs to treat the source code as a document, and do so reliably and robustly. For more information on why it is impossible to parse perl, see Randal Schwartz's seminal response to the question of "Why can't you parse Perl". L The purpose of PPI is B to parse Perl I, but to parse Perl I. By treating the problem this way, we are able to parse a single file containing Perl source code "isolated" from any other resources, such as libraries upon which the code may depend, and without needing to run an instance of perl alongside or inside the parser. Historically, using an embedded perl parser was widely considered to be the most likely avenue for finding a solution to parsing Perl. It has been investigated from time to time, but attempts have generally failed or suffered from sufficiently bad corner cases that they were abandoned. =head2 What Does PPI Stand For? C is an acronym for the longer original module name C. And in the spirit of the silly acronym games played by certain unnamed Open Source projects you may have I of, it is also a reverse backronym of "I Parse Perl". Of course, I could just be lying and have just made that second bit up 10 minutes before the release of PPI 1.000. Besides, B the cool Perl packages have TLAs (Three Letter Acronyms). It's a rule or something. Why don't you just think of it as the B for simplicity. The original name was shortened to prevent the author (and you the users) from contracting RSI by having to type crazy things like C 100 times a day. In acknowledgment that someone may some day come up with a valid solution for the grammar problem it was decided at the commencement of the project to leave the C namespace free for any such effort. Since that time I've been able to prove to my own satisfaction that it B truly impossible to accurately parse Perl as both code and document at once. For the academics, parsing Perl suffers from the "Halting Problem". =head2 Why Parse Perl? Once you can accept that we will never be able to parse Perl well enough to meet the standards of things that treat Perl as code, it is worth re-examining I we want to "parse" Perl at all. What are the things that people might want a "Perl parser" for? =over 4 =item Documentation Analyzing the contents of a Perl document to automatically generate documentation, in parallel to, or as a replacement for, POD documentation. Allow an indexer to locate and process all the comments and documentation from code for "full text search" applications. =item Structural and Quality Analysis Determine quality or other metrics across a body of code, and identify situations relating to particular phrases, techniques or locations. Index functions, variables and packages within Perl code, and doing search and graph (in the node/edge sense) analysis of large code bases. L, based on PPI, is a large, thriving tool for bug detection and style analysis of Perl code. =item Refactoring Make structural, syntax, or other changes to code in an automated manner, either independently or in assistance to an editor. This sort of task list includes backporting, forward porting, partial evaluation, "improving" code, or whatever. All the sort of things you'd want from a L. =item Layout Change the layout of code without changing its meaning. This includes techniques such as tidying (like L), obfuscation, compressing and "squishing", or to implement formatting preferences or policies. =item Presentation This includes methods of improving the presentation of code, without changing the content of the code. Modify, improve, syntax colour etc the presentation of a Perl document. Generating "IntelliText"-like functions. =back If we treat this as a baseline for the sort of things we are going to have to build on top of Perl, then it becomes possible to identify a standard for how good a Perl parser needs to be. =head2 How good is Good Enough(TM) PPI seeks to be good enough to achieve all of the above tasks, or to provide a sufficiently good API on which to allow others to implement modules in these and related areas. However, there are going to be limits to this process. Because PPI cannot adapt to changing grammars, any code written using source filters should not be assumed to be parsable. At one extreme, this includes anything munged by L, as well as (arguably) more common cases like L. We do not pretend to be able to always parse code using these modules, although as long as it still follows a format that looks like Perl syntax, it may be possible to extend the lexer to handle them. The ability to extend PPI to handle lexical additions to the language is on the drawing board to be done some time post-1.0 The goal for success was originally to be able to successfully parse 99% of all Perl documents contained in CPAN. This means the entire file in each case. PPI has succeeded in this goal far beyond the expectations of even the author. At time of writing there are only 28 non-Acme Perl modules in CPAN that PPI is incapable of parsing. Most of these are so badly broken they do not compile as Perl code anyway. So unless you are actively going out of your way to break PPI, you should expect that it will handle your code just fine. =head2 Internationalisation PPI provides partial support for internationalisation and localisation. Specifically, it allows the use of characters from the Latin-1 character set to be used in quotes, comments, and POD. Primarily, this covers languages from Europe and South America. PPI does B currently provide support for Unicode. If you need Unicode support and would like to help, contact the author. (contact details below) =head2 Round Trip Safe When PPI parses a file it builds B into the model, including whitespace. This is needed in order to make the Document fully "Round Trip" safe. The general concept behind a "Round Trip" parser is that it knows what it is parsing is somewhat uncertain, and so B to get things wrong from time to time. In the cases where it parses code wrongly the tree will serialize back out to the same string of code that was read in, repairing the parser's mistake as it heads back out to the file. The end result is that if you parse in a file and serialize it back out without changing the tree, you are guaranteed to get the same file you started with. PPI does this correctly and reliably for 100% of all known cases. B The one minor exception at this time is that if the newlines for your file are wrong (meaning not matching the platform newline format), PPI will localise them for you. (It isn't to be convenient, supporting arbitrary newlines would make some of the code more complicated) Better control of the newline type is on the wish list though, and anyone wanting to help out is encouraged to contact the author. =head1 IMPLEMENTATION =head2 General Layout PPI is built upon two primary "parsing" components, L and L, and a large tree of about 70 classes which implement the various the I (PDOM). The PDOM is conceptually similar in style and intent to the regular DOM or other code Abstract Syntax Trees (ASTs), but contains some differences to handle perl-specific cases, and to assist in treating the code as a document. Please note that it is B an implementation of the official Document Object Model specification, only somewhat similar to it. On top of the Tokenizer, Lexer and the classes of the PDOM, sit a number of classes intended to make life a little easier when dealing with PDOM trees. Both the major parsing components were hand-coded from scratch with only plain Perl code and a few small utility modules. There are no grammar or patterns mini-languages, no YACC or LEX style tools and only a small number of regular expressions. This is primarily because of the sheer volume of accumulated cruft that exists in Perl. Not even perl itself is capable of parsing Perl documents (remember, it just parses and executes it as code). As a result, PPI needed to be cruftier than perl itself. Feel free to shudder at this point, and hope you never have to understand the Tokenizer codebase. Speaking of which... =head2 The Tokenizer The Tokenizer takes source code and converts it into a series of tokens. It does this using a slow but thorough character by character manual process, rather than using a pattern system or complex regexes. Or at least it does so conceptually. If you were to actually trace the code you would find it's not truly character by character due to a number of regexps and optimisations throughout the code. This lets the Tokenizer "skip ahead" when it can find shortcuts, so it tends to jump around a line a bit wildly at times. In practice, the number of times the Tokenizer will B move the character cursor itself is only about 5% - 10% higher than the number of tokens contained in the file. This makes it about as optimal as it can be made without implementing it in something other than Perl. In 2001 when PPI was started, this structure made PPI quite slow, and not really suitable for interactive tasks. This situation has improved greatly with multi-gigahertz processors, but can still be painful when working with very large files. The target parsing rate for PPI is about 5000 lines per gigacycle. It is currently believed to be at about 1500, and the main avenue for making it to the target speed has now become L, a drop-in XS accelerator for PPI. Since L has only just gotten off the ground and is currently only at proof-of-concept stage, this may take a little while. Anyone interested in helping out with L is B encouraged to contact the author. In fact, the design of L means it's possible to port one function at a time safely and reliably. So every little bit will help. =head2 The Lexer The Lexer takes a token stream, and converts it to a lexical tree. Because we are parsing Perl B this includes whitespace, comments, and all number of weird things that have no relevance when code is actually executed. An instantiated L consumes L objects and produces L objects. However you should probably never be working with the Lexer directly. You should just be able to create L objects and work with them directly. =head2 The Perl Document Object Model The PDOM is a structured collection of data classes that together provide a correct and scalable model for documents that follow the standard Perl syntax. =head2 The PDOM Class Tree The following lists all of the 72 current PDOM classes, listing with indentation based on inheritance. PPI::Element PPI::Node PPI::Document PPI::Document::Fragment PPI::Statement PPI::Statement::Package PPI::Statement::Include PPI::Statement::Sub PPI::Statement::Scheduled PPI::Statement::Compound PPI::Statement::Break PPI::Statement::Given PPI::Statement::When PPI::Statement::Data PPI::Statement::End PPI::Statement::Expression PPI::Statement::Variable PPI::Statement::Null PPI::Statement::UnmatchedBrace PPI::Statement::Unknown PPI::Structure PPI::Structure::Block PPI::Structure::Subscript PPI::Structure::Constructor PPI::Structure::Condition PPI::Structure::List PPI::Structure::For PPI::Structure::Given PPI::Structure::When PPI::Structure::Unknown PPI::Token PPI::Token::Whitespace PPI::Token::Comment PPI::Token::Pod PPI::Token::Number PPI::Token::Number::Binary PPI::Token::Number::Octal PPI::Token::Number::Hex PPI::Token::Number::Float PPI::Token::Number::Exp PPI::Token::Number::Version PPI::Token::Word PPI::Token::DashedWord PPI::Token::Symbol PPI::Token::Magic PPI::Token::ArrayIndex PPI::Token::Operator PPI::Token::Quote PPI::Token::Quote::Single PPI::Token::Quote::Double PPI::Token::Quote::Literal PPI::Token::Quote::Interpolate PPI::Token::QuoteLike PPI::Token::QuoteLike::Backtick PPI::Token::QuoteLike::Command PPI::Token::QuoteLike::Regexp PPI::Token::QuoteLike::Words PPI::Token::QuoteLike::Readline PPI::Token::Regexp PPI::Token::Regexp::Match PPI::Token::Regexp::Substitute PPI::Token::Regexp::Transliterate PPI::Token::HereDoc PPI::Token::Cast PPI::Token::Structure PPI::Token::Label PPI::Token::Separator PPI::Token::Data PPI::Token::End PPI::Token::Prototype PPI::Token::Attribute PPI::Token::Unknown To summarize the above layout, all PDOM objects inherit from the L class. Under this are L, strings of content with a known type, and L, syntactically significant containers that hold other Elements. The three most important of these are the L, the L and the L classes. =head2 The Document, Statement and Structure At the top of all complete PDOM trees is a L object. It represents a complete file of Perl source code as you might find it on disk. There are some specialised types of document, such as L and L but for the purposes of the PDOM they are all just considered to be the same thing. Each Document will contain a number of B, B and B. A L is any series of Tokens and Structures that are treated as a single contiguous statement by perl itself. You should note that a Statement is as close as PPI can get to "parsing" the code in the sense that perl-itself parses Perl code when it is building the op-tree. Because of the isolation and Perl's syntax, it is provably impossible for PPI to accurately determine precedence of operators or which tokens are implicit arguments to a sub call. So rather than lead you on with a bad guess that has a strong chance of being wrong, PPI does not attempt to determine precedence or sub parameters at all. At a fundamental level, it only knows that this series of elements represents a single Statement as perl sees it, but it can do so with enough certainty that it can be trusted. However, for specific Statement types the PDOM is able to derive additional useful information about their meaning. For the best, most useful, and most heavily used example, see L. A L is any series of tokens contained within matching braces. This includes code blocks, conditions, function argument braces, anonymous array and hash constructors, lists, scoping braces and all other syntactic structures represented by a matching pair of braces, including (although it may not seem obvious at first) CREADLINEE> braces. Each Structure contains none, one, or many Tokens and Structures (the rules for which vary for the different Structure subclasses) Under the PDOM structure rules, a Statement can B directly contain another child Statement, a Structure can B directly contain another child Structure, and a Document can B contain another Document anywhere in the tree. Aside from these three rules, the PDOM tree is extremely flexible. =head2 The PDOM at Work To demonstrate the PDOM in use lets start with an example showing how the tree might look for the following chunk of simple Perl code. #!/usr/bin/perl print( "Hello World!" ); exit(); Translated into a PDOM tree it would have the following structure (as shown via the included L). PPI::Document PPI::Token::Comment '#!/usr/bin/perl\n' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'print' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Quote::Double '"Hello World!"' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'exit' PPI::Structure::List ( ... ) PPI::Token::Structure ';' PPI::Token::Whitespace '\n' Please note that in this example, strings are only listed for the B L that contains that string. Structures are listed with the type of brace characters they represent noted. The L module can be used to generate similar trees yourself. We can make that PDOM dump a little easier to read if we strip out all the whitespace. Here it is again, sans the distracting whitespace tokens. PPI::Document PPI::Token::Comment '#!/usr/bin/perl\n' PPI::Statement PPI::Token::Word 'print' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Quote::Double '"Hello World!"' PPI::Token::Structure ';' PPI::Statement PPI::Token::Word 'exit' PPI::Structure::List ( ... ) PPI::Token::Structure ';' As you can see, the tree can get fairly deep at time, especially when every isolated token in a bracket becomes its own statement. This is needed to allow anything inside the tree the ability to grow. It also makes the search and analysis algorithms much more flexible. Because of the depth and complexity of PDOM trees, a vast number of very easy to use methods have been added wherever possible to help people working with PDOM trees do normal tasks relatively quickly and efficiently. =head2 Overview of the Primary Classes The main PPI classes, and links to their own documentation, are listed here in alphabetical order. =over 4 =item L The Document object, the root of the PDOM. =item L A cohesive fragment of a larger Document. Although not of any real current use, it is needed for use in certain internal tree manipulation algorithms. For example, doing things like cut/copy/paste etc. Very similar to a L, but has some additional methods and does not represent a lexical scope boundary. A document fragment is also non-serializable, and so cannot be written out to a file. =item L A simple class for dumping readable debugging versions of PDOM structures, such as in the demonstration above. =item L The Element class is the abstract base class for all objects within the PDOM =item L Implements an instantiable object form of a PDOM tree search. =item L The PPI Lexer. Converts Token streams into PDOM trees. =item L The Node object, the abstract base class for all PDOM objects that can contain other Elements, such as the Document, Statement and Structure objects. =item L The base class for all Perl statements. Generic "evaluate for side-effects" statements are of this actual type. Other more interesting statement types belong to one of its children. See its own documentation for a longer description and list of all of the different statement types and sub-classes. =item L The abstract base class for all structures. A Structure is a language construct consisting of matching braces containing a set of other elements. See the L documentation for a description and list of all of the different structure types and sub-classes. =item L A token is the basic unit of content. At its most basic, a Token is just a string tagged with metadata (its class, and some additional flags in some cases). =item L The L and L classes provide abstract base classes for the many and varied types of quote and quote-like things in Perl. However, much of the actual quote logic is implemented in a separate quote engine, based at L. Classes that inherit from L, L and L are generally parsed only by the Quote Engine. =item L The PPI Tokenizer. One Tokenizer consumes a chunk of text and provides access to a stream of L objects. The Tokenizer is very very complicated, to the point where even the author treads carefully when working with it. Most of the complication is the result of optimizations which have tripled the tokenization speed, at the expense of maintainability. We cope with the spaghetti by heavily commenting everything. =item L The Perl Document Transformation API. Provides a standard interface and abstract base class for objects and classes that manipulate Documents. =back =head1 INSTALLING The core PPI distribution is pure Perl and has been kept as tight as possible and with as few dependencies as possible. It should download and install normally on any platform from within the CPAN and CPANPLUS applications, or directly using the distribution tarball. If installing by hand, you may need to install a few small utility modules first. The exact ones will depend on your version of perl. There are no special install instructions for PPI, and the normal C, C, C, C instructions apply. =head1 EXTENDING The PPI namespace itself is reserved for use by PPI itself. You are recommended to use the PPIx:: namespace for PPI-specific modifications or prototypes thereof, or Perl:: for modules which provide a general Perl language-related functions. If what you wish to implement looks like it fits into the PPIx:: namespace, you should consider contacting the PPI maintainers on GitHub first, as what you want may already be in progress, or you may wish to consider contributing to PPI itself. =head1 TO DO - Many more analysis and utility methods for PDOM classes - Creation of a PPI::Tutorial document - Add many more key functions to PPI::XS - We can B write more and better unit tests - Complete the full implementation of -Eliteral (1.200) - Full understanding of scoping (due 1.300) =head1 SUPPORT The most recent version of PPI is available at the following address. L PPI source is maintained in a GitHub repository at the following address. L Contributions via GitHub pull request are welcome. Bug fixes in the form of pull requests or bug reports with new (failing) unit tests have the best chance of being addressed by busy maintainers, and are B encouraged. If you cannot provide a test or fix, or don't have time to do so, then regular bug reports are still accepted and appreciated via the GitHub bug tracker. L The C utility that is part of the L distribution is a useful tool for demonstrating how PPI is parsing (or misparsing) small code snippets, and for providing information for bug reports. For other issues, questions, or commercial or media-related enquiries, contact the author. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 ACKNOWLEDGMENTS A huge thank you to Phase N Australia (L) for permitting the original open sourcing and release of this distribution from what was originally several thousand hours of commercial work. Another big thank you to The Perl Foundation (L) for funding for the final big refactoring and completion run. Also, to the various co-maintainers that have contributed both large and small with tests and patches and especially to those rare few who have deep-dived into the guts to (gasp) add a feature. - Dan Brook : PPIx::XPath, Acme::PerlML - Audrey Tang : "Line Noise" Testing - Arjen Laarhoven : Three-element ->location support - Elliot Shank : Perl 5.10 support, five-element ->location And finally, thanks to those brave ( and foolish :) ) souls willing to dive in and use, test drive and provide feedback on PPI before version 1.000, in some cases before it made it to beta quality, and still did extremely distasteful things (like eating 50 meg of RAM a second). I owe you all a beer. Corner me somewhere and collect at your convenience. If I missed someone who wasn't in my email history, thank you too :) # In approximate order of appearance - Claes Jacobsson - Michael Schwern - Jeff T. Parsons - CPAN Author "CHOCOLATEBOY" - Robert Rotherberg - CPAN Author "PODMASTER" - Richard Soderberg - Nadim ibn Hamouda el Khemir - Graciliano M. P. - Leon Brocard - Jody Belka - Curtis Ovid - Yuval Kogman - Michael Schilli - Slaven Rezic - Lars Thegler - Tony Stubblebine - Tatsuhiko Miyagawa - CPAN Author "CHROMATIC" - Matisse Enzer - Roy Fulbright - Dan Brook - Johnny Lee - Johan Lindstrom And to single one person out, thanks go to Randal Schwartz who spent a great number of hours in IRC over a critical 6 month period explaining why Perl is impossibly unparsable and constantly shoving evil and ugly corner cases in my face. He remained a tireless devil's advocate, and without his support this project genuinely could never have been completed. So for my schooling in the Deep Magiks, you have my deepest gratitude Randal. =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/0000775000175000017500000000000014573465137012026 5ustar olafolafPPI-1.278/lib/PPI/Token/0000775000175000017500000000000014573465137013106 5ustar olafolafPPI-1.278/lib/PPI/Token/BOM.pm0000644000175000017500000000471214573465137014063 0ustar olafolafpackage PPI::Token::BOM; =pod =head1 NAME PPI::Token::BOM - Tokens representing Unicode byte order marks =head1 INHERITANCE PPI::Token::BOM isa PPI::Token isa PPI::Element =head1 DESCRIPTION This is a special token in that it can only occur at the beginning of documents. If a BOM byte mark occurs elsewhere in a file, it should be treated as L. We recognize the byte order marks identified at this URL: L UTF-32, big-endian 00 00 FE FF UTF-32, little-endian FF FE 00 00 UTF-16, big-endian FE FF UTF-16, little-endian FF FE UTF-8 EF BB BF Note that as of this writing, PPI only has support for UTF-8 (namely, in POD and strings) and no support for UTF-16 or UTF-32. We support the BOMs of the latter two for completeness only. The BOM is considered non-significant, like white space. =head1 METHODS There are no additional methods beyond those provided by the parent L and L classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; sub significant() { '' } ##################################################################### # Parsing Methods my %bom_types = ( "\x00\x00\xfe\xff" => 'UTF-32', "\xff\xfe\x00\x00" => 'UTF-32', "\xfe\xff" => 'UTF-16', "\xff\xfe" => 'UTF-16', "\xef\xbb\xbf" => 'UTF-8', ); sub __TOKENIZER__on_line_start { my $t = $_[1]; $_ = $t->{line}; if (m/^(\x00\x00\xfe\xff | # UTF-32, big-endian \xff\xfe\x00\x00 | # UTF-32, little-endian \xfe\xff | # UTF-16, big-endian \xff\xfe | # UTF-16, little-endian \xef\xbb\xbf) # UTF-8 /xs) { my $bom = $1; if ($bom_types{$bom} ne 'UTF-8') { return $t->_error("$bom_types{$bom} is not supported"); } $t->_new_token('BOM', $bom) or return undef; $t->{line_cursor} += length $bom; } # Continue just as if there was no BOM $t->{class} = 'PPI::Token::Whitespace'; return $t->{class}->__TOKENIZER__on_line_start($t); } 1; =pod =head1 SUPPORT See the L in the main module =head1 AUTHOR Chris Dolan Ecdolan@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Prototype.pm0000644000175000017500000000404714573465137015454 0ustar olafolafpackage PPI::Token::Prototype; =pod =head1 NAME PPI::Token::Prototype - A subroutine prototype descriptor =head1 INHERITANCE PPI::Token::End isa PPI::Token isa PPI::Element =head1 SYNOPSIS sub ($@) prototype; =head1 DESCRIPTION Although it sort of looks like a list or condition, a subroutine prototype is a lot more like a string. Its job is to provide hints to the perl compiler on what type of arguments a particular subroutine expects, which the compiler uses to validate parameters at compile-time, and allows programmers to use the functions without explicit parameter parens. Due to the rise of OO Perl coding, which ignores these prototypes, they are most often used to allow for constant-like things, and to "extend" the language and create things that act like keywords and core functions. # Create something that acts like a constant sub MYCONSTANT () { 10 } # Create the "any" core-looking function sub any (&@) { ... } if ( any { $_->cute } @babies ) { ... } =head1 METHODS This class provides one additional method beyond those defined by the L and L parent classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Quote::Literal"; =pod =head2 prototype The C accessor returns the actual prototype pattern, stripped of flanking parens and of all whitespace. This mirrors the behavior of the Perl C builtin function. Note that stripping parens and whitespace means that the return of C can be an empty string. =cut sub prototype { my $self = shift; my $proto = $self->content; $proto =~ s/(^\(|\)$|\s+)//g; $proto; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Attribute.pm0000644000175000017500000000735514573465137015417 0ustar olafolafpackage PPI::Token::Attribute; =pod =head1 NAME PPI::Token::Attribute - A token for a subroutine attribute =head1 INHERITANCE PPI::Token::Attribute isa PPI::Token isa PPI::Element =head1 DESCRIPTION In Perl, attributes are a relatively recent addition to the language. Given the code C< sub foo : bar(something) {} >, the C part is the attribute. A C token represents the entire of the attribute, as the braces and its contents are not parsed into the tree, and are treated by Perl (and thus by us) as a single string. =head1 METHODS This class provides some additional methods beyond those provided by its L and L parent classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # PPI::Token::Attribute Methods =pod =head2 identifier The C attribute returns the identifier part of the attribute. That is, for the attribute C, the C method would return C<"foo">. =cut sub identifier { my $self = shift; $self->{content} =~ /^(.+?)\(/ ? $1 : $self->{content}; } =pod =head2 parameters The C method returns the parameter string for the attribute. That is, for the attribute C, the C method would return C<"bar">. Returns the parameters as a string (including the null string C<''> for the case of an attribute such as C.) Returns C if the attribute does not have parameters. =cut sub parameters { my $self = shift; $self->{content} =~ /\((.*)\)$/ ? $1 : undef; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Unless this is a '(', we are finished. unless ( $char eq '(' ) { # Finalise and recheck return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # This is a bar(...) style attribute. # We are currently on the ( so scan in until the end. # We finish on the character AFTER our end my $string = $class->__TOKENIZER__scan_for_end( $t ); if ( ref $string ) { # EOF $t->{token}->{content} .= $$string; $t->_finalize_token; return 0; } # Found the end of the attribute $t->{token}->{content} .= $string; $t->_finalize_token->__TOKENIZER__on_char( $t ); } # Scan for a close braced, and take into account both escaping, # and open close bracket pairs in the string. When complete, the # method leaves the line cursor on the LAST character found. sub __TOKENIZER__scan_for_end { my $t = $_[1]; # Loop as long as we can get new lines my $string = ''; my $depth = 0; while ( exists $t->{line} ) { # Get the search area pos $t->{line} = $t->{line_cursor}; # Look for a match unless ( $t->{line} =~ /\G((?:\\.|[^()])*?[()])/gc ) { # Load in the next line and push to first character $string .= substr( $t->{line}, $t->{line_cursor} ); $t->_fill_line(1) or return \$string; $t->{line_cursor} = 0; next; } # Add to the string $string .= $1; $t->{line_cursor} += length $1; # Alter the depth and continue if we aren't at the end $depth += ($1 =~ /\($/) ? 1 : -1 and next; # Found the end return $string; } # Returning the string as a reference indicates EOF \$string; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/QuoteLike/0000775000175000017500000000000014573465137015010 5ustar olafolafPPI-1.278/lib/PPI/Token/QuoteLike/Words.pm0000644000175000017500000000336714573465137016453 0ustar olafolafpackage PPI::Token::QuoteLike::Words; =pod =head1 NAME PPI::Token::QuoteLike::Words - Word list constructor quote-like operator =head1 INHERITANCE PPI::Token::QuoteLike::Words isa PPI::Token::QuoteLike isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object represents a quote-like operator that acts as a constructor for a list of words. # Create a list for a significant chunk of the alphabet my @list = qw{a b c d e f g h i j k l}; =head1 METHODS =cut use strict; use PPI::Token::QuoteLike (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::QuoteLike }; =pod =head2 literal Returns the words contained as a list. Note that this method does not check the context that the token is in; it always returns the list and not merely the last element if the token is in scalar context. =cut sub literal { my ( $self ) = @_; my $content = $self->_section_content(0); return if !defined $content; # Undo backslash escaping of '\', the left delimiter, # and the right delimiter. The right delimiter will # only exist with paired delimiters: qw() qw[] qw<> qw{}. my ( $left, $right ) = ( $self->_delimiters, '', '' ); $content =~ s/\\([\Q$left$right\\\E])/$1/g; my @words = split ' ', $content; return @words; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/QuoteLike/Readline.pm0000644000175000017500000000247414573465137017076 0ustar olafolafpackage PPI::Token::QuoteLike::Readline; =pod =head1 NAME PPI::Token::QuoteLike::Readline - The readline quote-like operator =head1 INHERITANCE PPI::Token::QuoteLike::Readline isa PPI::Token::QuoteLike isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C quote-like operator is used to read either a single line from a file, or all the lines from a file, as follows. # Read in a single line $line = ; # From a scalar handle $line = <$filehandle>; # Read all the lines @lines = ; =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::QuoteLike (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::QuoteLike }; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/QuoteLike/Command.pm0000644000175000017500000000221614573465137016723 0ustar olafolafpackage PPI::Token::QuoteLike::Command; =pod =head1 NAME PPI::Token::QuoteLike::Command - The command quote-like operator =head1 INHERITANCE PPI::Token::QuoteLike::Command isa PPI::Token::QuoteLike isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object represents a command output capturing quote-like operator. =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::QuoteLike (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::QuoteLike }; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/QuoteLike/Backtick.pm0000644000175000017500000000220714573465137017060 0ustar olafolafpackage PPI::Token::QuoteLike::Backtick; =pod =head1 NAME PPI::Token::QuoteLike::Backtick - A `backticks` command token =head1 INHERITANCE PPI::Token::QuoteLike::Backtick isa PPI::Token::QuoteLike isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object represents a command output capturing quote. =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::QuoteLike (); use PPI::Token::_QuoteEngine::Simple (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Simple PPI::Token::QuoteLike }; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/QuoteLike/Regexp.pm0000644000175000017500000000442714573465137016605 0ustar olafolafpackage PPI::Token::QuoteLike::Regexp; =pod =head1 NAME PPI::Token::QuoteLike::Regexp - Regexp constructor quote-like operator =head1 INHERITANCE PPI::Token::QuoteLike::Regexp isa PPI::Token::QuoteLike isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object represents the quote-like operator used to construct anonymous L objects, as follows. # Create a Regexp object for a module filename my $module = qr/\.pm$/; =head1 METHODS The following methods are provided by this class, beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::QuoteLike (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::QuoteLike }; ##################################################################### # PPI::Token::QuoteLike::Regexp Methods =pod =head2 get_match_string The C method returns the portion of the string that will be compiled into the match portion of the regexp. =cut sub get_match_string { return $_[0]->_section_content( 0 ); } =pod =head2 get_substitute_string The C method always returns C, since the C construction provides no substitution string. This method is provided for orthogonality with C. =cut sub get_substitute_string { return undef; } =pod =head2 get_modifiers The C method returns the modifiers that will be compiled into the regexp. =cut sub get_modifiers { return $_[0]->_modifiers(); } =pod =head2 get_delimiters The C method returns the delimiters of the string as an array. The first and only element is the delimiters of the string to be compiled into a match string. =cut sub get_delimiters { return $_[0]->_delimiters(); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Unknown.pm0000644000175000017500000003051114573465137015101 0ustar olafolafpackage PPI::Token::Unknown; =pod =head1 NAME PPI::Token::Unknown - Token of unknown or as-yet undetermined type =head1 INHERITANCE PPI::Token::Unknown isa PPI::Token isa PPI::Element =head1 DESCRIPTION Object of the type C exist primarily inside the tokenizer, where they are temporarily brought into existing for a very short time to represent a token that could be one of a number of types. Generally, they only exist for a character or two, after which they are resolved and converted into the correct type. For an object of this type to survive the parsing process is considered a major bug. Please report any C you encounter in a L object as a bug. =cut use strict; use PPI::Token (); use PPI::Exception (); use PPI::Singletons qw' %MAGIC $CURLY_SYMBOL '; our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my ( $self, $t ) = @_; # Self and Tokenizer my $c = $t->{token}->{content}; # Current token my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Current character # Now, we split on the different values of the current content if ( $c eq '*' ) { # Is it a number? if ( $char =~ /\d/ ) { # bitwise operator $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } if ( $char =~ /[\w:]/ ) { # Symbol (unless the thing before it is a number my ( $prev ) = $t->_previous_significant_tokens(1); if ( not $prev or not $prev->isa('PPI::Token::Number') ) { $t->{class} = $t->{token}->set_class( 'Symbol' ); return 1; } } if ( $char eq '{' ) { # Get rest of line pos $t->{line} = $t->{line_cursor} + 1; if ( $t->{line} =~ m/$CURLY_SYMBOL/gc ) { # control-character symbol (e.g. *{^_Foo}) $t->{class} = $t->{token}->set_class( 'Magic' ); return 1; } } # Postfix dereference: ->** if ( $char eq '*' ) { my ( $prev ) = $t->_previous_significant_tokens(1); if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) { $t->{class} = $t->{token}->set_class( 'Cast' ); return 1; } } if ( $char eq '*' || $char eq '=' ) { # Power operator '**' or mult-assign '*=' $t->{class} = $t->{token}->set_class( 'Operator' ); return 1; } return $self->_as_cast_or_op($t) if $self->_is_cast_or_op($char); $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } elsif ( $c eq '$' ) { # Postfix dereference: ->$* ->$#* if ( $char eq '*' || $char eq '#' ) { my ( $prev ) = $t->_previous_significant_tokens(1); if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) { $t->{class} = $t->{token}->set_class( 'Cast' ); return 1; } } if ( $char =~ /[a-z_]/i ) { # Symbol $t->{class} = $t->{token}->set_class( 'Symbol' ); return 1; } if ( $MAGIC{ $c . $char } ) { # Magic variable $t->{class} = $t->{token}->set_class( 'Magic' ); return 1; } if ( $char eq '{' ) { # Get rest of line pos $t->{line} = $t->{line_cursor} + 1; if ( $t->{line} =~ m/$CURLY_SYMBOL/gc ) { # control-character symbol (e.g. ${^MATCH}) $t->{class} = $t->{token}->set_class( 'Magic' ); return 1; } } # Must be a cast $t->{class} = $t->{token}->set_class( 'Cast' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } elsif ( $c eq '@' ) { # Postfix dereference: ->@* if ( $char eq '*' ) { my ( $prev ) = $t->_previous_significant_tokens(1); if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) { $t->{class} = $t->{token}->set_class( 'Cast' ); return 1; } } if ( $char =~ /[\w:]/ ) { # Symbol $t->{class} = $t->{token}->set_class( 'Symbol' ); return 1; } if ( $MAGIC{ $c . $char } ) { # Magic variable $t->{class} = $t->{token}->set_class( 'Magic' ); return 1; } if ( $char eq '{' ) { # Get rest of line pos $t->{line} = $t->{line_cursor} + 1; if ( $t->{line} =~ m/$CURLY_SYMBOL/gc ) { # control-character symbol (e.g. @{^_Foo}) $t->{class} = $t->{token}->set_class( 'Magic' ); return 1; } } # Must be a cast $t->{class} = $t->{token}->set_class( 'Cast' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } elsif ( $c eq '%' ) { # Postfix dereference: ->%* ->%[...] if ( $char eq '*' || $char eq '[' ) { my ( $prev ) = $t->_previous_significant_tokens(1); if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) { if ( $char eq '*' ) { $t->{class} = $t->{token}->set_class( 'Cast' ); return 1; } if ( $char eq '[' ) { $t->{class} = $t->{token}->set_class( 'Cast' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } } } # Is it a number? if ( $char =~ /\d/ ) { # bitwise operator $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # Is it a magic variable? if ( $char eq '^' || $MAGIC{ $c . $char } ) { $t->{class} = $t->{token}->set_class( 'Magic' ); return 1; } if ( $char =~ /[\w:]/ ) { # Symbol (unless the thing before it is a number my ( $prev ) = $t->_previous_significant_tokens(1); if ( not $prev or not $prev->isa('PPI::Token::Number') ) { $t->{class} = $t->{token}->set_class( 'Symbol' ); return 1; } } if ( $char eq '{' ) { # Get rest of line pos $t->{line} = $t->{line_cursor} + 1; if ( $t->{line} =~ m/$CURLY_SYMBOL/gc ) { # control-character symbol (e.g. %{^_Foo}) $t->{class} = $t->{token}->set_class( 'Magic' ); return 1; } } return $self->_as_cast_or_op($t) if $self->_is_cast_or_op($char); # Probably the mod operator $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->{class}->__TOKENIZER__on_char( $t ); } elsif ( $c eq '&' ) { # Postfix dereference: ->&* if ( $char eq '*' ) { my ( $prev ) = $t->_previous_significant_tokens(1); if ( $prev and $prev->isa('PPI::Token::Operator') and $prev->content eq '->' ) { $t->{class} = $t->{token}->set_class( 'Cast' ); return 1; } } # Is it a number? if ( $char =~ /\d/ ) { # bitwise operator $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } if ( $char =~ /[\w:]/ ) { # Symbol (unless the thing before it is a number my ( $prev ) = $t->_previous_significant_tokens(1); if ( not $prev or not $prev->isa('PPI::Token::Number') ) { $t->{class} = $t->{token}->set_class( 'Symbol' ); return 1; } } return $self->_as_cast_or_op($t) if $self->_is_cast_or_op($char); # Probably the binary and operator $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->{class}->__TOKENIZER__on_char( $t ); } elsif ( $c eq '-' ) { if ( $char =~ /\d/o ) { # Number $t->{class} = $t->{token}->set_class( 'Number' ); return 1; } if ( $char eq '.' ) { # Number::Float $t->{class} = $t->{token}->set_class( 'Number::Float' ); return 1; } if ( $char =~ /[a-zA-Z]/ ) { $t->{class} = $t->{token}->set_class( 'DashedWord' ); return 1; } # The numeric negative operator $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->{class}->__TOKENIZER__on_char( $t ); } elsif ( $c eq ':' ) { if ( $char eq ':' ) { # ::foo style bareword $t->{class} = $t->{token}->set_class( 'Word' ); return 1; } # Now, : acts very very differently in different contexts. # Mainly, we need to find out if this is a subroutine attribute. # We'll leave a hint in the token to indicate that, if it is. if ( $self->__TOKENIZER__is_an_attribute( $t ) ) { # This : is an attribute indicator $t->{class} = $t->{token}->set_class( 'Operator' ); $t->{token}->{_attribute} = 1; return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # It MIGHT be a label, but it's probably the ?: trinary operator $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->{class}->__TOKENIZER__on_char( $t ); } # erm... PPI::Exception->throw('Unknown value in PPI::Token::Unknown token'); } sub _is_cast_or_op { my ( $self, $char ) = @_; return 1 if $char eq '$'; return 1 if $char eq '@'; return 1 if $char eq '%'; return 1 if $char eq '*'; return 1 if $char eq '{'; return; } sub _as_cast_or_op { my ( $self, $t ) = @_; my $class = _cast_or_op( $t ); $t->{class} = $t->{token}->set_class( $class ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } sub _prev_significant_w_cursor { my ( $tokens, $cursor, $extra_check ) = @_; while ( $cursor >= 0 ) { my $token = $tokens->[ $cursor-- ]; next if !$token->significant; next if $extra_check and !$extra_check->($token); return ( $token, $cursor ); } return ( undef, $cursor ); } # Operator/operand-sensitive, multiple or GLOB cast sub _cast_or_op { my ( $t ) = @_; my $tokens = $t->{tokens}; my $cursor = scalar( @$tokens ) - 1; my $token; ( $token, $cursor ) = _prev_significant_w_cursor( $tokens, $cursor ); return 'Cast' if !$token; # token was first in the document if ( $token->isa( 'PPI::Token::Structure' ) and $token->content eq '}' ) { # Scan the token stream backwards an arbitrarily long way, # looking for the matching opening curly brace. my $structure_depth = 1; ( $token, $cursor ) = _prev_significant_w_cursor( $tokens, $cursor, sub { my ( $token ) = @_; return if !$token->isa( 'PPI::Token::Structure' ); if ( $token eq '}' ) { $structure_depth++; return; } if ( $token eq '{' ) { $structure_depth--; return if $structure_depth; } return 1; } ); return 'Operator' if !$token; # no matching '{', probably an unbalanced '}' # Scan past any whitespace ( $token, $cursor ) = _prev_significant_w_cursor( $tokens, $cursor ); return 'Operator' if !$token; # Document began with what must be a hash constructor. return 'Operator' if $token->isa( 'PPI::Token::Symbol' ); # subscript my %meth_or_subscript_end = map { $_ => 1 } qw@ -> } ] @; return 'Operator' if $meth_or_subscript_end{ $token->content }; # subscript my $content = $token->content; my $produces_or_wants_value = ( $token->isa( 'PPI::Token::Word' ) and ( $content eq 'do' or $content eq 'eval' ) ); return $produces_or_wants_value ? 'Operator' : 'Cast'; } my %list_start_or_term_end = map { $_ => 1 } qw@ ; ( { [ @; return 'Cast' if $token->isa( 'PPI::Token::Structure' ) and $list_start_or_term_end{ $token->content } or $token->isa( 'PPI::Token::Cast' ) or $token->isa( 'PPI::Token::Operator' ) or $token->isa( 'PPI::Token::Label' ); return 'Operator' if !$token->isa( 'PPI::Token::Word' ); ( $token, $cursor ) = _prev_significant_w_cursor( $tokens, $cursor ); return 'Cast' if !$token || $token->content ne '->'; return 'Operator'; } # Are we at a location where a ':' would indicate a subroutine attribute sub __TOKENIZER__is_an_attribute { my $t = $_[1]; # Tokenizer object my @tokens = $t->_previous_significant_tokens(3); my $p0 = $tokens[0]; return '' if not $p0; # If we just had another attribute, we are also an attribute return 1 if $p0->isa('PPI::Token::Attribute'); # If we just had a prototype, then we are an attribute return 1 if $p0->isa('PPI::Token::Prototype'); # Other than that, we would need to have had a bareword return '' unless $p0->isa('PPI::Token::Word'); # We could be an anonymous subroutine if ( $p0->isa('PPI::Token::Word') and $p0->content eq 'sub' ) { return 1; } # Or, we could be a named subroutine my $p1 = $tokens[1]; my $p2 = $tokens[2]; if ( $p1 and $p1->isa('PPI::Token::Word') and $p1->content eq 'sub' and ( not $p2 or $p2->isa('PPI::Token::Structure') or ( $p2->isa('PPI::Token::Whitespace') and $p2->content eq '' ) ) ) { return 1; } # We aren't an attribute ''; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Operator.pm0000644000175000017500000000561514573465137015244 0ustar olafolafpackage PPI::Token::Operator; =pod =head1 NAME PPI::Token::Operator - Token class for operators =head1 INHERITANCE PPI::Token::Operator isa PPI::Token isa PPI::Element =head1 SYNOPSIS # This is the list of valid operators ++ -- ** ! ~ + - =~ !~ * / % x << >> lt gt le ge cmp ~~ == != <=> . .. ... , & | ^ && || // ? : **= += -= .= *= /= %= x= &= |= ^= <<= >>= &&= ||= //= < > <= >= <> => -> and or xor not eq ne <<>> =head1 DESCRIPTION All operators in PPI are created as C objects, including the ones that may superficially look like a L object. =head1 METHODS There are no additional methods beyond those provided by the parent L and L classes. =cut use strict; use PPI::Token (); use PPI::Singletons '%OPERATOR'; our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $t = $_[1]; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Are we still an operator if we add the next character my $content = $t->{token}->{content}; # special case for <<>> operator if(length($content) < 4 && $content . substr( $t->{line}, $t->{line_cursor}, 4 - length($content) ) eq '<<>>') { return 1; } return 1 if $OPERATOR{ $content . $char }; # Handle the special case of a .1234 decimal number if ( $content eq '.' ) { if ( $char =~ /^[0-9]$/ ) { # This is a decimal number $t->{class} = $t->{token}->set_class('Number::Float'); return $t->{class}->__TOKENIZER__on_char( $t ); } } # Handle the special case if we might be a here-doc if ( $content eq '<<' ) { pos $t->{line} = $t->{line_cursor}; # Either <{line} =~ m/\G ~? (?: (?!\d)\w | \s*['"`] | \\\w ) /gcx ) { # This is a here-doc. # Change the class and move to the HereDoc's own __TOKENIZER__on_char method. $t->{class} = $t->{token}->set_class('HereDoc'); return $t->{class}->__TOKENIZER__on_char( $t ); } } # Handle the special case of the null Readline $t->{class} = $t->{token}->set_class('QuoteLike::Readline') if $content eq '<>' or $content eq '<<>>'; # Finalize normally $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Comment.pm0000644000175000017500000000655114573465137015053 0ustar olafolafpackage PPI::Token::Comment; =pod =head1 NAME PPI::Token::Comment - A comment in Perl source code =head1 INHERITANCE PPI::Token::Comment isa PPI::Token isa PPI::Element =head1 SYNOPSIS # This is a PPI::Token::Comment print "Hello World!"; # So it this $string =~ s/ foo # This, unfortunately, is not :( bar /w; =head1 DESCRIPTION In PPI, comments are represented by C objects. These come in two flavours, line comment and inline comments. A C is a comment that stands on its own line. These comments hold their own newline and whitespace (both leading and trailing) as part of the one C object. An inline comment is a comment that appears after some code, and continues to the end of the line. This does B include whitespace, and the terminating newlines is considered a separate L token. This is largely a convenience, simplifying a lot of normal code relating to the common things people do with comments. Most commonly, it means when you C or C a comment, a line comment disappears taking the entire line with it, and an inline comment is removed from the inside of the line, allowing the newline to drop back onto the end of the code, as you would expect. It also means you can move comments around in blocks much more easily. For now, this is a suitably handy way to do things. However, I do reserve the right to change my mind on this one if it gets dangerously anachronistic somewhere down the line. =head1 METHODS Only very limited methods are available, beyond those provided by our parent L and L classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ### XS -> PPI/XS.xs:_PPI_Token_Comment__significant 0.900+ sub significant() { '' } # Most stuff goes through __TOKENIZER__commit. # This is such a rare case, do char at a time to keep the code small sub __TOKENIZER__on_char { my $t = $_[1]; # Make sure not to include the trailing newline if ( substr( $t->{line}, $t->{line_cursor}, 1 ) eq "\n" ) { return $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; } sub __TOKENIZER__commit { my $t = $_[1]; # Get the rest of the line my $rest = substr( $t->{line}, $t->{line_cursor} ); if ( chomp $rest ) { # Include the newline separately # Add the current token, and the newline $t->_new_token('Comment', $rest); $t->_new_token('Whitespace', "\n"); } else { # Add this token only $t->_new_token('Comment', $rest); } # Advance the line cursor to the end $t->{line_cursor} = $t->{line_length} - 1; 0; } # Comments end at the end of the line sub __TOKENIZER__on_line_end { $_[1]->_finalize_token if $_[1]->{token}; 1; } =pod =head2 line The C accessor returns true if the C is a line comment, or false if it is an inline comment. =cut sub line { # Entire line comments have a newline at the end $_[0]->{content} =~ /\n$/ ? 1 : 0; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Label.pm0000644000175000017500000000210714573465137014461 0ustar olafolafpackage PPI::Token::Label; =pod =head1 NAME PPI::Token::Label - Token class for a statement label =head1 INHERITANCE PPI::Token::Label isa PPI::Token isa PPI::Element =head1 DESCRIPTION A label is an identifier attached to a line or statements, to allow for various types of flow control. For example, a loop might have a label attached so that a C or C flow control statement can be used from multiple levels below to reference the loop directly. =head1 METHODS There are no additional methods beyond those provided by the parent L and L classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/HereDoc.pm0000644000175000017500000002224614573465137014761 0ustar olafolafpackage PPI::Token::HereDoc; =pod =head1 NAME PPI::Token::HereDoc - Token class for the here-doc =head1 INHERITANCE PPI::Token::HereDoc isa PPI::Token isa PPI::Element =head1 DESCRIPTION Here-docs are incredibly handy when writing Perl, but incredibly tricky when parsing it, primarily because they don't follow the general flow of input. They jump ahead and nab lines directly off the input buffer. Whitespace and newlines may not matter in most Perl code, but they matter in here-docs. They are also tricky to store as an object. They look sort of like an operator and a string, but they don't act like it. And they have a second section that should be something like a separate token, but isn't because a string can span from above the here-doc content to below it. So when parsing, this is what we do. Firstly, the PPI::Token::HereDoc object, does not represent the C<<< << >>> operator, or the "END_FLAG", or the content, or even the terminator. It represents all of them at once. The token itself has only the declaration part as its "content". # This is what the content of a HereDoc token is < method on a HereDoc token, you get '<< "FOO"'. As for the content and the terminator, when treated purely in "content" terms they do not exist. The content is made available with the C method, and the name of the terminator with the C method. To make things work in the way you expect, PPI has to play some games when doing line/column location calculation for tokens, and also during the content parsing and generation processes. Documents cannot simply by recreated by stitching together the token contents, and involve a somewhat more expensive procedure, but the extra expense should be relatively negligible unless you are doing huge quantities of them. Please note that due to the immature nature of PPI in general, we expect C to be a rich (bad) source of corner-case bugs for quite a while, but for the most part they should more or less DWYM. =head2 Comparison to other string types Although technically it can be considered a quote, for the time being C are being treated as a completely separate C subclass, and will not be found in a search for L or L objects. This may change in the future, with it most likely to end up under QuoteLike. =head1 METHODS Although it has the standard set of C methods, C objects have a relatively large number of unique methods all of their own. =cut use strict; our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # PPI::Token::HereDoc Methods =pod =head2 heredoc The C method is the authoritative method for accessing the contents of the C object. It returns the contents of the here-doc as a list of newline-terminated strings. If called in scalar context, it returns the number of lines in the here-doc, B the terminator line. =cut sub heredoc { @{shift->{_heredoc}} } =pod =head2 indentation The C method returns the indentation string of an indented here-doc if that can be determined. If the indented here-doc is damaged (say, missing terminator) or the here-doc was not indented, it returns C. =cut sub indentation { shift->{_indentation} } =pod =head2 terminator The C method returns the name of the terminating string for the here-doc. Returns the terminating string as an unescaped string (in the rare case the terminator has an escaped quote in it). =cut sub terminator { shift->{_terminator}; } sub _is_terminator { my ( $self, $terminator, $line, $indented ) = @_; if ( $indented ) { return $line =~ /^\s*\Q$terminator\E$/; } else { return $line eq $terminator; } } sub _indent { my ( $self, $token ) = @_; my ($indent) = $token->{_terminator_line} =~ /^(\s*)/; return $indent; } sub _is_match_indent { my ( $self, $token, $indent ) = @_; return (grep { /^$indent/ || $_ eq "\n" } @{$token->{_heredoc}}) == @{$token->{_heredoc}}; } ##################################################################### # Tokenizer Methods # Parse in the entire here-doc in one call sub __TOKENIZER__on_char { my ( $self, $t ) = @_; # We are currently located on the first char after the << # Handle the most common form first for simplicity and speed reasons ### FIXME - This regex, and this method in general, do not yet allow ### for the null here-doc, which terminates at the first ### empty line. pos $t->{line} = $t->{line_cursor}; if ( $t->{line} !~ m/\G( ~? \s* (?: "[^"]*" | '[^']*' | `[^`]*` | \\?\w+ ) )/gcx ) { # Degenerate to a left-shift operation $t->{token}->set_class('Operator'); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # Add the rest of the token, work out what type it is, # and suck in the content until the end. my $token = $t->{token}; $token->{content} .= $1; $t->{line_cursor} += length $1; # Find the terminator, clean it up and determine # the type of here-doc we are dealing with. my $content = $token->{content}; if ( $content =~ /^\<\<(~?)(\w+)$/ ) { # Bareword $token->{_mode} = 'interpolate'; $token->{_indented} = 1 if $1 eq '~'; $token->{_terminator} = $2; } elsif ( $content =~ /^\<\<(~?)\s*\'(.*)\'$/ ) { # ''-quoted literal $token->{_mode} = 'literal'; $token->{_indented} = 1 if $1 eq '~'; $token->{_terminator} = $2; $token->{_terminator} =~ s/\\'/'/g; } elsif ( $content =~ /^\<\<(~?)\s*\"(.*)\"$/ ) { # ""-quoted literal $token->{_mode} = 'interpolate'; $token->{_indented} = 1 if $1 eq '~'; $token->{_terminator} = $2; $token->{_terminator} =~ s/\\"/"/g; } elsif ( $content =~ /^\<\<(~?)\s*\`(.*)\`$/ ) { # ``-quoted command $token->{_mode} = 'command'; $token->{_indented} = 1 if $1 eq '~'; $token->{_terminator} = $2; $token->{_terminator} =~ s/\\`/`/g; } elsif ( $content =~ /^\<\<(~?)\\(\w+)$/ ) { # Legacy forward-slashed bareword $token->{_mode} = 'literal'; $token->{_indented} = 1 if $1 eq '~'; $token->{_terminator} = $2; } else { # WTF? return undef; } # Suck in the HEREDOC $token->{_heredoc} = \my @heredoc; my $terminator = $token->{_terminator} . "\n"; while ( defined( my $line = $t->_get_line ) ) { if ( $self->_is_terminator( $terminator, $line, $token->{_indented} ) ) { # Keep the actual termination line for consistency # when we are re-assembling the file $token->{_terminator_line} = $line; if ( $token->{_indented} ) { my $indent = $self->_indent( $token ); $token->{_indentation} = $indent; # Indentation of here-doc doesn't match delimiter unless ( $self->_is_match_indent( $token, $indent ) ) { push @heredoc, $line; last; } s/^$indent// for @heredoc, $token->{_terminator_line}; } # The HereDoc is now fully parsed return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # Add the line push @heredoc, $line; } # End of file. # Error: Didn't reach end of here-doc before end of file. # If the here-doc block is not empty, look at the last line to determine if # the here-doc terminator is missing a newline (which Perl would fail to # compile but is easy to detect) or if the here-doc block was just not # terminated at all (which Perl would fail to compile as well). $token->{_terminator_line} = undef; if ( @heredoc and defined $heredoc[-1] ) { # See PPI::Tokenizer, the algorithm there adds a space at the end of the # document that we need to make sure we remove. if ( $t->{source_eof_chop} ) { chop $heredoc[-1]; $t->{source_eof_chop} = ''; } # Check if the last line of the file matches the terminator without # newline at the end. If so, remove it from the content and set it as # the terminator line. $token->{_terminator_line} = pop @heredoc if $self->_is_terminator( $token->{_terminator}, $heredoc[-1], $token->{_indented} ); } if ( $token->{_indented} && $token->{_terminator_line} ) { my $indent = $self->_indent( $token ); $token->{_indentation} = $indent; if ( $self->_is_match_indent( $token, $indent ) ) { # Remove indent from here-doc as much as possible s/^$indent// for @heredoc; } s/^$indent// for $token->{_terminator_line}; } # Set a hint for PPI::Document->serialize so it can # inexpensively repair it if needed when writing back out. $token->{_damaged} = 1; # The HereDoc is not fully parsed $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 TO DO - Implement PPI::Token::Quote interface compatibility - Check CPAN for any use of the null here-doc or here-doc-in-s///e - Add support for the null here-doc - Add support for here-doc in s///e =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/ArrayIndex.pm0000644000175000017500000000251314573465137015511 0ustar olafolafpackage PPI::Token::ArrayIndex; =pod =head1 NAME PPI::Token::ArrayIndex - Token getting the last index for an array =head1 INHERITANCE PPI::Token::ArrayIndex isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C token represents an attempt to get the last index of an array, such as C<$#array>. =head1 METHODS There are no additional methods beyond those provided by the parent L and L classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $t = $_[1]; # Suck in till the end of the arrayindex pos $t->{line} = $t->{line_cursor}; if ( $t->{line} =~ m/\G([\w:']+)/gc ) { $t->{token}->{content} .= $1; $t->{line_cursor} += length $1; } # End of token $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Number.pm0000644000175000017500000000650114573465137014674 0ustar olafolafpackage PPI::Token::Number; =pod =head1 NAME PPI::Token::Number - Token class for a number =head1 SYNOPSIS $n = 1234; # decimal integer $n = 0b1110011; # binary integer $n = 01234; # octal integer $n = 0x1234; # hexadecimal integer $n = 12.34e-56; # exponential notation ( currently not working ) =head1 INHERITANCE PPI::Token::Number isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that represent numbers, in the various types that Perl supports. =head1 METHODS =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; =pod =head2 base The C method is provided by all of the ::Number subclasses. This is 10 for decimal, 16 for hexadecimal, 2 for binary, etc. =cut sub base() { 10 } =pod =head2 literal Return the numeric value of this token. =cut sub literal { return 0 + $_[0]->_literal; } sub _literal { # De-sugar the string representation my $self = shift; my $string = $self->content; $string =~ s/^\+//; $string =~ s/_//g; return $string; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Allow underscores straight through return 1 if $char eq '_'; # Handle the conversion from an unknown to known type. # The regex covers "potential" hex/bin/octal number. my $token = $t->{token}; if ( $token->{content} =~ /^-?0_*$/ ) { # This could be special if ( $char eq 'x' || $char eq 'X' ) { $t->{class} = $t->{token}->set_class( 'Number::Hex' ); return 1; } elsif ( $char eq 'b' || $char eq 'B' ) { $t->{class} = $t->{token}->set_class( 'Number::Binary' ); return 1; } elsif ( $char eq 'o' || $char eq 'O' ) { $t->{class} = $t->{token}->set_class( 'Number::Octal' ); return 1; } elsif ( $char =~ /\d/ ) { # You cannot have 8s and 9s on octals if ( $char eq '8' or $char eq '9' ) { $token->{_error} = "Illegal character in octal number '$char'"; } $t->{class} = $t->{token}->set_class( 'Number::Octal' ); return 1; } } # Handle the easy case, integer or real. return 1 if $char =~ /\d/o; if ( $char eq '.' ) { $t->{class} = $t->{token}->set_class( 'Number::Float' ); return 1; } if ( $char eq 'e' || $char eq 'E' ) { $t->{class} = $t->{token}->set_class( 'Number::Exp' ); return 1; } # Doesn't fit a special case, or is after the end of the token # End of token. $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 CAVEATS Compared to Perl, the number tokenizer is too liberal about allowing underscores anywhere. For example, the following is a syntax error in Perl, but is allowed in PPI: 0_b10 =head1 TO DO - Treat v-strings as binary strings or barewords, not as "base-256" numbers - Break out decimal integers into their own subclass? - Implement literal() =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Word.pm0000644000175000017500000002233514573465137014362 0ustar olafolafpackage PPI::Token::Word; =pod =head1 NAME PPI::Token::Word - The generic "word" Token =head1 INHERITANCE PPI::Token::Word isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object is a PPI-specific representation of several different types of word-like things, and is one of the most common Token classes found in typical documents. Specifically, it includes not only barewords, but also any other valid Perl identifier including non-operator keywords and core functions, and any include C<::> separators inside it, as long as it fits the format of a class, function, etc. =head1 METHODS There are no methods available for C beyond those provided by its L and L parent classes. We expect to add additional methods to help further resolve a Word as a function, method, etc over time. If you need such a thing right now, look at L. =cut use strict; use PPI::Token (); use PPI::Singletons qw' %OPERATOR %QUOTELIKE %KEYWORDS '; our $VERSION = '1.278'; our @ISA = "PPI::Token"; =pod =head2 literal Returns the value of the Word as a string. This assumes (often incorrectly) that the Word is a bareword and not a function, method, keyword, etc. This differs from C because C expands to C. =cut sub literal { my $self = shift; my $word = $self->content; # Expand Foo'Bar to Foo::Bar $word =~ s/\'/::/g; return $word; } =pod =head2 method_call Answers whether this is the name of a method in a method call. Returns true if yes, false if no, and nothing if unknown. =cut sub method_call { my $self = shift; my $previous = $self->sprevious_sibling; if ( $previous and $previous->isa('PPI::Token::Operator') and $previous->content eq '->' ) { return 1; } my $snext = $self->snext_sibling; return 0 unless $snext; if ( $snext->isa('PPI::Structure::List') or $snext->isa('PPI::Token::Structure') or $snext->isa('PPI::Token::Operator') and ( $snext->content eq ',' or $snext->content eq '=>' ) ) { return 0; } if ( $snext->isa('PPI::Token::Word') and $snext->content =~ m< \w :: \z >xms ) { return 1; } return; } sub __TOKENIZER__on_char { my $class = shift; my $t = shift; # Suck in till the end of the bareword pos $t->{line} = $t->{line_cursor}; if ( $t->{line} =~ m/\G(\w+(?:(?:\'|::)\w+)*(?:::)?)/gc ) { my $word = $1; # Special Case: If we accidentally treat eq'foo' like # the word "eq'foo", then just make 'eq' (or whatever # else is in the %KEYWORDS hash. if ( $word =~ /^(\w+)'/ && $KEYWORDS{$1} ) { $word = $1; } $t->{token}->{content} .= $word; $t->{line_cursor} += length $word; } # We might be a subroutine attribute. if ( __current_token_is_attribute($t) ) { $t->{class} = $t->{token}->set_class( 'Attribute' ); return $t->{class}->__TOKENIZER__commit( $t ); } my $word = $t->{token}->{content}; if ( $KEYWORDS{$word} ) { # Check for a Perl keyword that is forced to be a normal word instead if ( $t->__current_token_is_forced_word ) { $t->{class} = $t->{token}->set_class( 'Word' ); return $t->{class}->__TOKENIZER__on_char( $t ); } # Check for a quote like operator. %QUOTELIKE must be subset of %KEYWORDS if ( $QUOTELIKE{$word} ) { $t->{class} = $t->{token}->set_class( $QUOTELIKE{$word} ); return $t->{class}->__TOKENIZER__on_char( $t ); } # Or one of the word operators. %OPERATOR must be subset of %KEYWORDS if ( $OPERATOR{$word} ) { $t->{class} = $t->{token}->set_class( 'Operator' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } } # Unless this is a simple identifier, at this point # it has to be a normal bareword if ( $word =~ /\:/ ) { return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # If the NEXT character in the line is a colon, this # is a label. my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); if ( $char eq ':' ) { $t->{token}->{content} .= ':'; $t->{line_cursor}++; $t->{class} = $t->{token}->set_class( 'Label' ); # If not a label, '_' on its own is the magic filehandle } elsif ( $word eq '_' ) { $t->{class} = $t->{token}->set_class( 'Magic' ); } # Finalise and process the character again $t->_finalize_token->__TOKENIZER__on_char( $t ); } # We are committed to being a bareword. # Or so we would like to believe. sub __TOKENIZER__commit { my ($class, $t) = @_; # Our current position is the first character of the bareword. # Capture the bareword. pos $t->{line} = $t->{line_cursor}; unless ( $t->{line} =~ m/\G((?!\d)\w+(?:(?:\'|::)\w+)*(?:::)?)/gc ) { # Programmer error die sprintf "Fatal error... regex failed to match in '%s' when expected", substr $t->{line}, $t->{line_cursor}; } # Special Case: If we accidentally treat eq'foo' like the word "eq'foo", # then unwind it and just make it 'eq' (or the other stringy comparitors) my $word = $1; if ( $word =~ /^(\w+)'/ && $KEYWORDS{$1} ) { $word = $1; } # Advance the position one after the end of the bareword $t->{line_cursor} += length $word; # We might be a subroutine attribute. if ( __current_token_is_attribute($t) ) { $t->_new_token( 'Attribute', $word ); return ($t->{line_cursor} >= $t->{line_length}) ? 0 : $t->{class}->__TOKENIZER__on_char($t); } # Check for the end of the file if ( $word eq '__END__' ) { # Create the token for the __END__ itself $t->_new_token( 'Separator', $1 ); $t->_finalize_token; # Move into the End zone (heh) $t->{zone} = 'PPI::Token::End'; # Add the rest of the line as a comment, and a whitespace newline # Anything after the __END__ on the line is "ignored". So we must # also ignore it, by turning it into a comment. my $end_rest = substr( $t->{line}, $t->{line_cursor} ); $t->{line_cursor} = length $t->{line}; if ( $end_rest =~ /\n$/ ) { chomp $end_rest; $t->_new_token( 'Comment', $end_rest ) if length $end_rest; $t->_new_token( 'Whitespace', "\n" ); } else { $t->_new_token( 'Comment', $end_rest ) if length $end_rest; } $t->_finalize_token; return 0; } # Check for the data section if ( $word eq '__DATA__' ) { # Create the token for the __DATA__ itself $t->_new_token( 'Separator', "$1" ); $t->_finalize_token; # Move into the Data zone $t->{zone} = 'PPI::Token::Data'; # Add the rest of the line as the Data token my $data_rest = substr( $t->{line}, $t->{line_cursor} ); $t->{line_cursor} = length $t->{line}; if ( $data_rest =~ /\n$/ ) { chomp $data_rest; $t->_new_token( 'Comment', $data_rest ) if length $data_rest; $t->_new_token( 'Whitespace', "\n" ); } else { $t->_new_token( 'Comment', $data_rest ) if length $data_rest; } $t->_finalize_token; return 0; } my $token_class; if ( $word =~ /\:/ ) { # Since it's not a simple identifier... $token_class = 'Word'; } elsif ( $KEYWORDS{$word} and $t->__current_token_is_forced_word ) { $token_class = 'Word'; } elsif ( $QUOTELIKE{$word} ) { # Special Case: A Quote-like operator $t->_new_token( $QUOTELIKE{$word}, $word ); return ($t->{line_cursor} >= $t->{line_length}) ? 0 : $t->{class}->__TOKENIZER__on_char( $t ); } elsif ( $OPERATOR{$word} && ($word ne 'x' || $t->_current_x_is_operator) ) { # Word operator $token_class = 'Operator'; } else { # Get tokens early to be sure to not disturb state set up by pos and m//gc. my @tokens = $t->_previous_significant_tokens(1); # If the next character is a ':' then it's a label... pos $t->{line} = $t->{line_cursor}; if ( $t->{line} =~ m/\G(\s*:)(?!:)/gc ) { if ( $tokens[0] and $tokens[0]->{content} eq 'sub' ) { # ... UNLESS it's after 'sub' in which # case it is a sub name and an attribute # operator. # We COULD have checked this at the top # level of checks, but this would impose # an additional performance per-word # penalty, and every other case where the # attribute operator doesn't directly # touch the object name already works. $token_class = 'Word'; } elsif ( !($tokens[0] and $tokens[0]->isa('PPI::Token::Operator')) ) { $word .= $1; $t->{line_cursor} += length($1); $token_class = 'Label'; } else { $token_class = 'Word'; } } elsif ( $word eq '_' ) { $token_class = 'Magic'; } else { $token_class = 'Word'; } } # Create the new token and finalise $t->_new_token( $token_class, $word ); if ( $t->{line_cursor} >= $t->{line_length} ) { # End of the line $t->_finalize_token; return 0; } $t->_finalize_token->__TOKENIZER__on_char($t); } # Is the current Word really a subroutine attribute? sub __current_token_is_attribute { my ( $t ) = @_; my @tokens = $t->_previous_significant_tokens(1); return ( $tokens[0] and ( # hint from tokenizer $tokens[0]->{_attribute} # nothing between attribute and us except whitespace or $tokens[0]->isa('PPI::Token::Attribute') ) ); } 1; =pod =head1 TO DO - Add C, C etc detector methods =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Symbol.pm0000644000175000017500000001235414573465137014714 0ustar olafolafpackage PPI::Token::Symbol; =pod =head1 NAME PPI::Token::Symbol - A token class for variables and other symbols =head1 INHERITANCE PPI::Token::Symbol isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used to cover all tokens that represent variables and other things that start with a sigil. =head1 METHODS This class has several methods beyond what is provided by its L and L parent classes. Most methods are provided to help work out what the object is actually pointing at, rather than what it might appear to be pointing at. =cut use strict; use Params::Util qw{_INSTANCE}; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # PPI::Token::Symbol Methods =pod =head2 canonical The C method returns a normalized, canonical version of the symbol. For example, it converts C<$ ::foo'bar::baz> to C<$main::foo::bar::baz>. This does not fully resolve the symbol, but merely removes syntax variations. =cut sub canonical { my $symbol = shift->content; $symbol =~ s/\s+//; $symbol =~ s/\'/::/g; $symbol =~ s/(?<=[\$\@\%\&\*])::/main::/; $symbol; } =pod =head2 symbol The C method returns the ACTUAL symbol this token refers to. A token of C<$foo> might actually be referring to C<@foo>, if it is found in the form C<$foo[1]>. This method attempts to resolve these issues to determine the actual symbol. Returns the symbol as a string. =cut my %cast_which_trumps_braces = map { $_ => 1 } qw{ $ @ % }; sub symbol { my $self = shift; my $symbol = $self->canonical; # Immediately return the cases where it can't be anything else my $type = substr( $symbol, 0, 1 ); return $symbol if $type eq '&'; # Unless the next significant Element is a structure, it's correct. my $after = $self->snext_sibling; return $symbol unless _INSTANCE($after, 'PPI::Structure'); # Process the rest for cases where it might actually be something else my $braces = $after->braces; return $symbol unless defined $braces; if ( $type eq '$' ) { # If it is cast to '$' or '@', that trumps any braces my $before = $self->sprevious_sibling; return $symbol if $before && $before->isa( 'PPI::Token::Cast' ) && $cast_which_trumps_braces{ $before->content }; # Otherwise the braces rule substr( $symbol, 0, 1, '@' ) if $braces eq '[]'; substr( $symbol, 0, 1, '%' ) if $braces eq '{}'; } elsif ( $type eq '@' ) { substr( $symbol, 0, 1, '%' ) if $braces eq '{}'; } elsif ( $type eq '%' ) { substr( $symbol, 0, 1, '@' ) if $braces eq '[]'; } $symbol; } =pod =head2 raw_type The C method returns the B type of the symbol in the form of its sigil. Returns the sigil as a string. =cut sub raw_type { substr( $_[0]->content, 0, 1 ); } =pod =head2 symbol_type The C method returns the B type of the symbol in the form of its sigil. Returns the sigil as a string. =cut sub symbol_type { substr( $_[0]->symbol, 0, 1 ); } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $t = $_[1]; # Suck in till the end of the symbol pos $t->{line} = $t->{line_cursor}; if ( $t->{line} =~ m/\G([\w:\']+)/gc ) { $t->{token}->{content} .= $1; $t->{line_cursor} += length $1; } # Handle magic things my $content = $t->{token}->{content}; if ( $content eq '@_' or $content eq '$_' ) { $t->{class} = $t->{token}->set_class( 'Magic' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # Shortcut for most of the X:: symbols if ( $content eq '$::' ) { # May well be an alternate form of a Magic my $nextchar = substr( $t->{line}, $t->{line_cursor}, 1 ); if ( $nextchar eq '|' ) { $t->{token}->{content} .= $nextchar; $t->{line_cursor}++; $t->{class} = $t->{token}->set_class( 'Magic' ); } return $t->_finalize_token->__TOKENIZER__on_char( $t ); } if ( $content =~ /^[\$%*@&]::(?:[^\w]|$)/ ) { my $current = substr( $content, 0, 3, '' ); $t->{token}->{content} = $current; $t->{line_cursor} -= length( $content ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } if ( $content =~ /^(?:\$|\@)\d+/ ) { $t->{class} = $t->{token}->set_class( 'Magic' ); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # Trim off anything we oversucked... $content =~ /^( [\$@%&*] (?: : (?!:) | # Allow single-colon non-magic variables (?: \w+ | \' (?!\d) \w+ | \:: \w+ ) (?: # Allow both :: and ' in namespace separators (?: \' (?!\d) \w+ | \:: \w+ ) )* (?: :: )? # Technically a compiler-magic hash, but keep it here ) )/x or return undef; unless ( length $1 eq length $content ) { $t->{line_cursor} += length($1) - length($content); $t->{token}->{content} = $1; } $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Separator.pm0000644000175000017500000000244014573465137015402 0ustar olafolafpackage PPI::Token::Separator; =pod =head1 NAME PPI::Token::Separator - The __DATA__ and __END__ tags =head1 INHERITANCE PPI::Token::Separator isa PPI::Token::Word isa PPI::Token isa PPI::Element =head1 DESCRIPTION Although superficially looking like a normal L object, when the C<__DATA__> and C<__END__> compiler tags appear at the beginning of a line (on supposedly) their own line, these tags become file section separators. The indicate that the time for Perl code is over, and the rest of the file is dedicated to something else (data in the case of C<__DATA__>) or to nothing at all (in the case of C<__END__>). =head1 METHODS This class has no methods beyond what is provided by its L, L and L parent classes. =cut use strict; use PPI::Token::Word (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Word"; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Regexp.pm0000644000175000017500000000474314573465137014704 0ustar olafolafpackage PPI::Token::Regexp; =pod =head1 NAME PPI::Token::Regexp - Regular expression abstract base class =head1 INHERITANCE PPI::Token::Regexp isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is never instantiated, and simply provides a common abstract base class for the three regular expression classes. These being: =over 2 =item m// - L =item s/// - L =item tr/// - L =back The names are hopefully obvious enough not to have to explain what each class is. See their pages for more details. To save some confusion, it's worth pointing out here that C is B a regular expression (which PPI takes to mean something that will actually examine or modify a string), but rather a quote-like operator that acts as a constructor for compiled L objects. =head1 METHODS The following methods are inherited by this class' offspring: =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # PPI::Token::Regexp Methods =pod =head2 get_match_string The C method returns the portion of the regexp that performs the match. =cut sub get_match_string { return $_[0]->_section_content( 0 ); } =pod =head2 get_substitute_string The C method returns the portion of the regexp that is substituted for the match, if any. If the regexp does not substitute, C is returned. =cut sub get_substitute_string { return $_[0]->_section_content( 1 ); } =pod =head2 get_modifiers The C method returns the modifiers of the regexp. =cut sub get_modifiers { return $_[0]->_modifiers(); } =pod =head2 get_delimiters The C method returns the delimiters of the regexp as an array. The first element is the delimiters of the match string, and the second element (if any) is the delimiters of the substitute string (if any). =cut sub get_delimiters { return $_[0]->_delimiters(); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Quote.pm0000644000175000017500000000465514573465137014551 0ustar olafolafpackage PPI::Token::Quote; =pod =head1 NAME PPI::Token::Quote - String quote abstract base class =head1 INHERITANCE PPI::Token::Quote isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is never instantiated, and simply provides a common abstract base class for the four quote classes. In PPI, a "quote" is limited to only the quote-like things that themselves directly represent a string. (although this includes double quotes with interpolated elements inside them, note that L allows to extract them). The subclasses of C are: =over 2 =item C<''> - L =item C - L =item C<""> - L =item C - L =back The names are hopefully obvious enough not to have to explain what each class is here. See their respective pages for more details. Please note that although the here-doc B represent a literal string, it is such a nasty piece of work that in L it is given the honor of its own token class (L). =head1 METHODS =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # PPI::Token::Quote Methods =pod =head2 string The C method is provided by all four ::Quote classes. It won't get you the actual literal Perl value, but it will strip off the wrapping of the quotes. # The following all return foo from the ->string method 'foo' "foo" q{foo} qq =cut #sub string { # my $class = ref $_[0] || $_[0]; # die "$class does not implement method ->string"; #} =pod =head2 literal The C method is provided by ::Quote::Literal and ::Quote::Single. This returns the value of the string as Perl sees it: without the quote marks and with C<\\> and C<\'> resolved to C<\> and C<'>. The C method is not implemented by ::Quote::Double or ::Quote::Interpolate yet. =cut 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Regexp/0000775000175000017500000000000014573465137014340 5ustar olafolafPPI-1.278/lib/PPI/Token/Regexp/Transliterate.pm0000644000175000017500000000262414573465137017521 0ustar olafolafpackage PPI::Token::Regexp::Transliterate; =pod =head1 NAME PPI::Token::Regexp::Transliterate - A transliteration regular expression token =head1 INHERITANCE PPI::Token::Regexp::Transliterate isa PPI::Token::Regexp isa PPI::Token isa PPI::Element =head1 SYNOPSIS $text =~ tr/abc/xyz/; =head1 DESCRIPTION A C object represents a single transliteration regular expression. I'm afraid you'll have to excuse the ridiculously long class name, but when push came to shove I ended up going for pedantically correct names for things (practically cut and paste from the various docs). =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::Regexp (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::Regexp }; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Regexp/Substitute.pm0000644000175000017500000000227314573465137017053 0ustar olafolafpackage PPI::Token::Regexp::Substitute; =pod =head1 NAME PPI::Token::Regexp::Substitute - A match and replace regular expression token =head1 INHERITANCE PPI::Token::Regexp::Substitute isa PPI::Token::Regexp isa PPI::Token isa PPI::Element =head1 SYNOPSIS $text =~ s/find/$replace/; =head1 DESCRIPTION A C object represents a single substitution regular expression. =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::Regexp (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::Regexp }; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Regexp/Match.pm0000644000175000017500000000270514573465137015734 0ustar olafolafpackage PPI::Token::Regexp::Match; =pod =head1 NAME PPI::Token::Regexp::Match - A standard pattern match regex =head1 INHERITANCE PPI::Token::Regexp::Match isa PPI::Token::Regexp isa PPI::Token isa PPI::Element =head1 SYNOPSIS $text =~ m/match regexp/; $text =~ /match regexp/; =head1 DESCRIPTION A C object represents a single match regular expression. Just to be doubly clear, here are things that are and B considered a match regexp. # Is a match regexp /This is a match regexp/; m/Old McDonald had a farm/eieio; # These are NOT match regexp qr/This is a regexp quote-like operator/; s/This is a/replace regexp/; =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::Regexp (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::Regexp }; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Number/0000775000175000017500000000000014573465137014336 5ustar olafolafPPI-1.278/lib/PPI/Token/Number/Exp.pm0000644000175000017500000000574414573465137015440 0ustar olafolafpackage PPI::Token::Number::Exp; =pod =head1 NAME PPI::Token::Number::Exp - Token class for an exponential notation number =head1 SYNOPSIS $n = 1.0e-2; $n = 1e+2; =head1 INHERITANCE PPI::Token::Number::Exp isa PPI::Token::Number::Float isa PPI::Token::Number isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that represent floating point numbers with exponential notation. =head1 METHODS =cut use strict; use PPI::Token::Number::Float (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Number::Float"; =pod =head2 literal Return the numeric value of this token. =cut sub literal { my $self = shift; return if $self->{_error}; my ($mantissa, $exponent) = split m/e/i, $self->_literal; my $neg = $mantissa =~ s/^\-//; $mantissa =~ s/^\./0./; $exponent =~ s/^\+//; # Must cast exponent as numeric type, due to string type '00' exponent # creating false positive condition in for() loop below, causing infinite loop $exponent += 0; # This algorithm is reasonably close to the S_mulexp10() # algorithm from the Perl source code, so it should arrive # at the same answer as Perl most of the time. my $negpow = 0; if ($exponent < 0) { $negpow = 1; $exponent *= -1; } my $result = 1; my $power = 10; for (my $bit = 1; $exponent; $bit = $bit << 1) { if ($exponent & $bit) { $exponent = $exponent ^ $bit; $result *= $power; } $power *= $power; } my $val = $neg ? 0 - $mantissa : $mantissa; return $negpow ? $val / $result : $val * $result; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # To get here, the token must have already encountered an 'E' # Allow underscores straight through return 1 if $char eq '_'; # Allow digits return 1 if $char =~ /\d/o; # Start of exponent is special if ( $t->{token}->{content} =~ /e$/i ) { # Allow leading +/- in exponent return 1 if $char eq '-' || $char eq '+'; # Invalid character in exponent. Recover if ( $t->{token}->{content} =~ s/\.(e)$//i ) { my $word = $1; $t->{class} = $t->{token}->set_class('Number'); $t->_new_token('Operator', '.'); $t->_new_token('Word', $word); return $t->{class}->__TOKENIZER__on_char( $t ); } else { $t->{token}->{_error} = "Illegal character in exponent '$char'"; } } # Doesn't fit a special case, or is after the end of the token # End of token. $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Chris Dolan Ecdolan@cpan.orgE =head1 COPYRIGHT Copyright 2006 Chris Dolan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Number/Octal.pm0000644000175000017500000000357714573465137015750 0ustar olafolafpackage PPI::Token::Number::Octal; =pod =head1 NAME PPI::Token::Number::Octal - Token class for a binary number =head1 SYNOPSIS $n = 0777; # octal integer =head1 INHERITANCE PPI::Token::Number::Octal isa PPI::Token::Number isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that represent base-8 numbers. =head1 METHODS =cut use strict; use PPI::Token::Number (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Number"; =pod =head2 base Returns the base for the number: 8. =cut sub base() { 8 } =pod =head2 literal Return the numeric value of this token. =cut sub literal { my $self = shift; return if $self->{_error}; my $str = $self->_literal; # oct supports '0o' notation only since 5.34 $str =~ s (^0[oO]) (0); my $neg = $str =~ s/^\-//; my $val = oct $str; return $neg ? -$val : $val; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Allow underscores straight through return 1 if $char eq '_'; if ( $char =~ /\d/ ) { # You cannot have 8s and 9s on octals if ( $char eq '8' or $char eq '9' ) { $t->{token}->{_error} = "Illegal character in octal number '$char'"; } return 1; } # Doesn't fit a special case, or is after the end of the token # End of token. $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Chris Dolan Ecdolan@cpan.orgE =head1 COPYRIGHT Copyright 2006 Chris Dolan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Number/Float.pm0000644000175000017500000000544114573465137015743 0ustar olafolafpackage PPI::Token::Number::Float; =pod =head1 NAME PPI::Token::Number::Float - Token class for a floating-point number =head1 SYNOPSIS $n = 1.234; =head1 INHERITANCE PPI::Token::Number::Float isa PPI::Token::Number isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that represent floating point numbers. A float is identified by n decimal point. Exponential notation (the C or C) is handled by the PPI::Token::Number::Exp class. =head1 METHODS =cut use strict; use PPI::Token::Number (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Number"; =pod =head2 base Returns the base for the number: 10. =cut sub base() { 10 } =pod =head2 literal Return the numeric value of this token. =cut sub literal { my $self = shift; my $str = $self->_literal; my $neg = $str =~ s/^\-//; $str =~ s/^\./0./; my $val = 0+$str; return $neg ? -$val : $val; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Allow underscores straight through return 1 if $char eq '_'; # Allow digits return 1 if $char =~ /\d/o; if ( $char eq '.' ) { # A second decimal point? That gets complicated. if ( $t->{token}{content} =~ /\.$/ ) { # We have a .., which is an operator. Take the . off the end of the # token and finish it, then make the .. operator. chop $t->{token}{content}; $t->{class} = $t->{token}->set_class( 'Number' ); $t->_new_token('Operator', '..'); return 0; } elsif ( $t->{token}{content} =~ /\._/ ) { ($t->{token}{content}, my $bareword) = split /\./, $t->{token}{content}; $t->{class} = $t->{token}->set_class( 'Number' ); $t->_new_token('Operator', '.'); $t->_new_token('Word', $bareword); $t->_new_token('Operator', '.'); return 0; } else { $t->{class} = $t->{token}->set_class( 'Number::Version' ); return 1; } } # perl seems to regard pretty much anything that's not strictly an exp num # as float + stuff my $char2 = substr $t->{line}, $t->{line_cursor}+1, 1; if ("$char$char2" =~ /[eE][0-9+-]/) { $t->{class} = $t->{token}->set_class( 'Number::Exp' ); return 1; } # Doesn't fit a special case, or is after the end of the token # End of token. $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Chris Dolan Ecdolan@cpan.orgE =head1 COPYRIGHT Copyright 2006 Chris Dolan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Number/Hex.pm0000644000175000017500000000330014573465137015412 0ustar olafolafpackage PPI::Token::Number::Hex; =pod =head1 NAME PPI::Token::Number::Hex - Token class for a binary number =head1 SYNOPSIS $n = 0x1234; # hexadecimal integer =head1 INHERITANCE PPI::Token::Number::Hex isa PPI::Token::Number isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that represent base-16 numbers. =head1 METHODS =cut use strict; use PPI::Token::Number (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Number"; =pod =head2 base Returns the base for the number: 16. =cut sub base() { 16 } =pod =head2 literal Return the numeric value of this token. =cut sub literal { my $self = shift; my $str = $self->_literal; my $neg = $str =~ s/^\-//; my $val = hex lc( $str ); # lc for compatibility with perls before 5.14 return $neg ? -$val : $val; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Allow underscores straight through return 1 if $char eq '_'; if ( $char =~ /[[:xdigit:]]/ ) { return 1; } # Doesn't fit a special case, or is after the end of the token # End of token. $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Chris Dolan Ecdolan@cpan.orgE =head1 COPYRIGHT Copyright 2006 Chris Dolan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Number/Binary.pm0000644000175000017500000000364014573465137016121 0ustar olafolafpackage PPI::Token::Number::Binary; =pod =head1 NAME PPI::Token::Number::Binary - Token class for a binary number =head1 SYNOPSIS $n = 0b1110011; # binary integer =head1 INHERITANCE PPI::Token::Number::Binary isa PPI::Token::Number isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that represent base-2 numbers. =head1 METHODS =cut use strict; use PPI::Token::Number (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Number"; =pod =head2 base Returns the base for the number: 2. =cut sub base() { 2 } =pod =head2 literal Return the numeric value of this token. =cut sub literal { my $self = shift; return if $self->{_error}; my $str = $self->_literal; my $neg = $str =~ s/^\-//; $str =~ s/^0[bB]//; my $val = 0; for my $bit ( $str =~ m/(.)/g ) { $val = $val * 2 + $bit; } return $neg ? -$val : $val; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Allow underscores straight through return 1 if $char eq '_'; if ( $char =~ /[\w\d]/ ) { unless ( $char eq '1' or $char eq '0' ) { # Add a warning if it contains non-binary chars $t->{token}->{_error} = "Illegal character in binary number '$char'"; } return 1; } # Doesn't fit a special case, or is after the end of the token # End of token. $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Chris Dolan Ecdolan@cpan.orgE =head1 COPYRIGHT Copyright 2006 Chris Dolan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Number/Version.pm0000644000175000017500000000660114573465137016322 0ustar olafolafpackage PPI::Token::Number::Version; =pod =head1 NAME PPI::Token::Number::Version - Token class for a byte-packed number =head1 SYNOPSIS $n = 1.1.0; $n = 127.0.0.1; $n = 10_000.10_000.10_000; $n = v1.2.3.4 =head1 INHERITANCE PPI::Token::Number::Version isa PPI::Token::Number isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that have multiple decimal points. In truth, these aren't treated like numbers at all by Perl, but they look like numbers to a parser. =head1 METHODS =cut use strict; use PPI::Token::Number (); our $VERSION = '1.278'; our @ISA = "PPI::Token::Number"; =pod =head2 base Returns the base for the number: 256. =cut sub base() { 256 } =pod =head2 literal Return the numeric value of this token. =cut sub literal { my $self = shift; my $content = $self->{content}; $content =~ s/^v//; return join '', map { chr $_ } ( split /\./, $content ); } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $class = shift; my $t = shift; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Allow digits return 1 if $char =~ /\d/o; if( $char eq '_' ) { return 1 if $t->{token}{content} !~ /\.$/; chop $t->{token}->{content}; $t->{class} = $t->{token}->set_class( 'Number::Float' ) if $t->{token}{content} !~ /\..+\./; $t->_new_token('Operator', '.'); $t->_new_token('Word', '_'); return 0; } # Is this a second decimal point in a row? Then the '..' operator if ( $char eq '.' ) { if ( $t->{token}->{content} =~ /\.$/ ) { # We have a .., which is an operator. # Take the . off the end of the token.. # and finish it, then make the .. operator. chop $t->{token}->{content}; $t->{class} = $t->{token}->set_class( 'Number::Float' ) if $t->{token}{content} !~ /\..+\./; $t->_new_token('Operator', '..'); return 0; } else { return 1; } } # Doesn't fit a special case, or is after the end of the token # End of token. $t->_finalize_token->__TOKENIZER__on_char( $t ); } sub __TOKENIZER__commit { my $t = $_[1]; # Capture the rest of the token pos $t->{line} = $t->{line_cursor}; # This was not a v-string after all (it's a word); return PPI::Token::Word->__TOKENIZER__commit($t) if $t->{line} !~ m/\G(v\d[_\d]*(?:\.\d[_\d]*)+|v\d[_\d]*\b)/gc; my $content = $1; # If there are no periods this could be a word starting with v\d # Forced to be a word. Done. return PPI::Token::Word->__TOKENIZER__commit($t) if $content !~ /\./ and $t->__current_token_is_forced_word($content); # This is a v-string $t->{line_cursor} += length $content; $t->_new_token( 'Number::Version', $content ); $t->_finalize_token->__TOKENIZER__on_char($t); } 1; =pod =head1 BUGS - Does not handle leading minus sign correctly. Should translate to a DashedWord. See L -95.0.1.0 --> "-_\000\cA\000" -96.0.1.0 --> Argument "`\0^A\0" isn't numeric in negation (-) =head1 SUPPORT See the L in the main module. =head1 AUTHOR Chris Dolan Ecdolan@cpan.orgE =head1 COPYRIGHT Copyright 2006 Chris Dolan. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/_QuoteEngine.pm0000644000175000017500000001354514573465137016034 0ustar olafolafpackage PPI::Token::_QuoteEngine; =pod =head1 NAME PPI::Token::_QuoteEngine - The PPI Quote Engine =head1 DESCRIPTION The C package is designed hold functionality for processing quotes and quote like operators, including regexes. These have special requirements in parsing. The C package itself provides various parsing methods, which the L, L and L can inherit from. In this sense, it serves as a base class. =head2 Using this class I<(Refers only to internal uses. This class does not provide a public interface)> To use these, you should initialize them as normal C<'$Class-Enew'>, and then call the 'fill' method, which will cause the specialised parser to scan forwards and parse the quote to its end point. If -Efill returns true, finalise the token. =cut use strict; use Carp (); our $VERSION = '1.278'; # Hook for the __TOKENIZER__on_char token call sub __TOKENIZER__on_char { my $class = shift; my $t = $_[0]->{token} ? shift : return undef; # Call the fill method to process the quote my $rv = $t->{token}->_fill( $t ); return undef unless defined $rv; ## Doesn't support "end of file" indicator # Finalize the token and return 0 to tell the tokenizer # to go to the next character. $t->_finalize_token; 0; } ##################################################################### # Optimised character processors, used for quotes # and quote like stuff, and accessible to the child classes # An outright scan, raw and fast. # Searches for a particular character, not escaped, loading in new # lines as needed. # When called, we start at the current position. # When leaving, the position should be set to the position # of the character, NOT the one after it. sub _scan_for_unescaped_character { my $class = shift; my $t = shift; my $char = (length $_[0] == 1) ? quotemeta shift : return undef; # Create the search regex. # Same as above but with a negative look-behind assertion. my $search = qr/(.*?(?{line} ) { # Get the search area for the current line pos $t->{line} = $t->{line_cursor}; # Can we find a match on this line if ( $t->{line} =~ m/\G$search/gc ) { # Found the character on this line $t->{line_cursor} += length($1) - 1; return $string . $1; } # Load in the next line $string .= substr $t->{line}, $t->{line_cursor}; my $rv = $t->_fill_line('inscan'); if ( $rv ) { # Push to first character $t->{line_cursor} = 0; } elsif ( defined $rv ) { # We hit the End of File return \$string; } else { # Unexpected error return undef; } } # We shouldn't be able to get here return undef; } # Scan for a close braced, and take into account both escaping, # and open close bracket pairs in the string. When complete, the # method leaves the line cursor on the LAST character found. sub _scan_for_brace_character { my $class = shift; my $t = shift; my $close_brace = $_[0] =~ /^(?:\>|\)|\}|\])$/ ? shift : Carp::confess(''); # return undef; my $open_brace = $close_brace; $open_brace =~ tr/\>\)\}\]/\<\(\{\[/; # Create the search string $close_brace = quotemeta $close_brace; $open_brace = quotemeta $open_brace; my $search = qr/\G(.*?(?{line} ) { # Get the search area pos $t->{line} = $t->{line_cursor}; # Look for a match unless ( $t->{line} =~ /$search/gc ) { # Load in the next line $string .= substr( $t->{line}, $t->{line_cursor} ); my $rv = $t->_fill_line('inscan'); if ( $rv ) { # Push to first character $t->{line_cursor} = 0; next; } if ( defined $rv ) { # We hit the End of File return \$string; } # Unexpected error return undef; } # Add to the string $string .= $1; $t->{line_cursor} += length $1; # Alter the depth and continue if we aren't at the end $depth += ($1 =~ /$open_brace$/) ? 1 : -1 and next; # Rewind the cursor by one character ( cludgy hack ) $t->{line_cursor} -= 1; return $string; } # Returning the string as a reference indicates EOF \$string; } # Find all spaces and comments, up to, but not including # the first non-whitespace character. # # Although it doesn't return it, it leaves the cursor # on the character following the gap sub _scan_quote_like_operator_gap { my $t = $_[1]; my $string = ''; while ( exists $t->{line} ) { # Get the search area for the current line pos $t->{line} = $t->{line_cursor}; # Since this regex can match zero characters, it should always match $t->{line} =~ /\G(\s*(?:\#.*)?)/gc or return undef; # Add the chars found to the string $string .= $1; # Did we match the entire line? unless ( $t->{line_cursor} + length $1 == length $t->{line} ) { # Partial line match, which means we are at # the end of the gap. Fix the cursor and return # the string. $t->{line_cursor} += length $1; return $string; } # Load in the next line. # If we reach the EOF, $t->{line} gets deleted, # which is caught by the while. my $rv = $t->_fill_line('inscan'); if ( $rv ) { # Set the cursor to the first character $t->{line_cursor} = 0; } elsif ( defined $rv ) { # Returning the string as a reference indicates EOF return \$string; } else { return undef; } } # Shouldn't be able to get here return undef; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Data.pm0000644000175000017500000000451014573465137014313 0ustar olafolafpackage PPI::Token::Data; =pod =head1 NAME PPI::Token::Data - The actual data in the __DATA__ section of a file =head1 INHERITANCE PPI::Token::Data isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used to represent the actual data inside a file's C<__DATA__> section. One C object is used to represent the entire of the data, primarily so that it can provide a convenient handle directly to the data. =head1 METHODS C provides one method in addition to those provided by our parent L and L classes. =cut use strict; use PPI::Token (); # IO::String emulates file handles using in memory strings. Perl can do this # directly on perl 5.8+ use constant USE_IO_STRING => $] < '5.008000'; use if USE_IO_STRING, 'IO::String'; # code may expect methods to be available on all file handles, so make sure # IO is loaded use if !USE_IO_STRING, 'IO::File'; our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # Methods =pod =head2 handle The C method returns a L handle that allows you to do all the normal handle-y things to the contents of the __DATA__ section of the file. Unlike in perl itself, this means you can also do things like C new data onto the end of the __DATA__ section, or modify it with any other process that can accept an L as input or output. Returns an L object. =cut sub handle { my $self = shift; # perl 5.6 compatibility if (USE_IO_STRING) { return IO::String->new( \$self->{content} ); } else { open my $fh, '+<', \$self->{content}; return $fh; } } sub __TOKENIZER__on_line_start { my ( $self, $t ) = @_; # Add the line if ( defined $t->{token} ) { $t->{token}->{content} .= $t->{line}; } else { defined( $t->{token} = $t->{class}->new( $t->{line} ) ) or return undef; } return 0; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/_QuoteEngine/0000775000175000017500000000000014573465137015470 5ustar olafolafPPI-1.278/lib/PPI/Token/_QuoteEngine/Full.pm0000644000175000017500000003043614573465137016734 0ustar olafolafpackage PPI::Token::_QuoteEngine::Full; # Full quote engine use strict; use Clone (); use Carp (); use PPI::Token::_QuoteEngine (); our $VERSION = '1.278'; our @ISA = 'PPI::Token::_QuoteEngine'; # Prototypes for the different braced sections my %SECTIONS = ( '(' => { type => '()', _close => ')' }, '<' => { type => '<>', _close => '>' }, '[' => { type => '[]', _close => ']' }, '{' => { type => '{}', _close => '}' }, ); # For each quote type, the extra fields that should be set. # This should give us faster initialization. my %QUOTES = ( 'q' => { operator => 'q', braced => undef, separator => undef, _sections => 1 }, 'qq' => { operator => 'qq', braced => undef, separator => undef, _sections => 1 }, 'qx' => { operator => 'qx', braced => undef, separator => undef, _sections => 1 }, 'qw' => { operator => 'qw', braced => undef, separator => undef, _sections => 1 }, 'qr' => { operator => 'qr', braced => undef, separator => undef, _sections => 1, modifiers => 1 }, 'm' => { operator => 'm', braced => undef, separator => undef, _sections => 1, modifiers => 1 }, 's' => { operator => 's', braced => undef, separator => undef, _sections => 2, modifiers => 1 }, 'tr' => { operator => 'tr', braced => undef, separator => undef, _sections => 2, modifiers => 1 }, # Y is the little-used variant of tr 'y' => { operator => 'y', braced => undef, separator => undef, _sections => 2, modifiers => 1 }, '/' => { operator => undef, braced => 0, separator => '/', _sections => 1, modifiers => 1 }, # Angle brackets quotes mean "readline(*FILEHANDLE)" '<' => { operator => undef, braced => 1, separator => undef, _sections => 1, }, # The final ( and kind of depreciated ) "first match only" one is not # used yet, since I'm not sure on the context differences between # this and the trinary operator, but it's here for completeness. '?' => { operator => undef, braced => 0, separator => '?', _sections => 1, modifiers => 1 }, # parse prototypes as a literal quote '(' => { operator => undef, braced => 1, separator => undef, _sections => 1, }, ); sub new { my $class = shift; my $init = defined $_[0] ? shift : Carp::croak("::Full->new called without init string"); # Create the token ### This manual SUPER'ing ONLY works because none of ### Token::Quote, Token::QuoteLike and Token::Regexp ### implement a new function of their own. my $self = PPI::Token::new( $class, $init ) or return undef; # Do we have a prototype for the initializer? If so, add the extra fields my $options = $QUOTES{$init} or return $self->_error( "Unknown quote type '$init'" ); foreach ( keys %$options ) { $self->{$_} = $options->{$_}; } # Set up the modifiers hash if needed $self->{modifiers} = {} if $self->{modifiers}; # Handle the special < base $self->{sections}[0] = Clone::clone $SECTIONS{'<'} if $init eq '<'; $self->{sections}[0] = Clone::clone $SECTIONS{'('} if $init eq '('; $self; } sub _fill { my $class = shift; my $t = shift; my $self = $t->{token} or Carp::croak("::Full->_fill called without current token"); # Load in the operator stuff if needed if ( $self->{operator} ) { # In an operator based quote-like, handle the gap between the # operator and the opening separator. if ( substr( $t->{line}, $t->{line_cursor}, 1 ) =~ /\s/ ) { # Go past the gap my $gap = $self->_scan_quote_like_operator_gap( $t ); return undef unless defined $gap; if ( ref $gap ) { # End of file $self->{content} .= $$gap; return 0; } $self->{content} .= $gap; } # The character we are now on is the separator. Capture, # and advance into the first section. my $sep = substr( $t->{line}, $t->{line_cursor}++, 1 ); $self->{content} .= $sep; # Determine if these are normal or braced type sections if ( my $section = $SECTIONS{$sep} ) { $self->{braced} = 1; $self->{sections}->[0] = Clone::clone($section); } else { $self->{braced} = 0; $self->{separator} = $sep; } } # Parse different based on whether we are normal or braced my $rv = $self->{braced} ? $self->_fill_braced($t) : $self->_fill_normal($t); return $rv if !$rv; # Return now unless it has modifiers ( i.e. s/foo//eieio ) return 1 unless $self->{modifiers}; # Check for modifiers my $char; my $len = 0; while ( ($char = substr( $t->{line}, $t->{line_cursor} + 1, 1 )) =~ /[^\W\d_]/ ) { $len++; $self->{content} .= $char; $self->{modifiers}->{lc $char} = 1; $t->{line_cursor}++; } } # Handle the content parsing path for normally separated sub _fill_normal { my $self = shift; my $t = shift; # Get the content up to the next separator my $string = $self->_scan_for_unescaped_character( $t, $self->{separator} ); return undef unless defined $string; if ( ref $string ) { # End of file if ( length($$string) > 1 ) { # Complete the properties for the first section my $str = $$string; chop $str; $self->{sections}->[0] = { position => length($self->{content}), size => length($$string) - 1, type => "$self->{separator}$self->{separator}", }; $self->{_sections} = 1; } else { # No sections at all $self->{sections} = [ ]; $self->{_sections} = 0; } $self->{content} .= $$string; return 0; } # Complete the properties of the first section $self->{sections}->[0] = { position => length $self->{content}, size => length($string) - 1, type => "$self->{separator}$self->{separator}", }; $self->{content} .= $string; # We are done if there is only one section return 1 if $self->{_sections} == 1; # There are two sections. # Advance into the next section $t->{line_cursor}++; # Get the content up to the end separator $string = $self->_scan_for_unescaped_character( $t, $self->{separator} ); return undef unless defined $string; if ( ref $string ) { # End of file if ( length($$string) > 1 ) { # Complete the properties for the second section my $str = $$string; chop $str; $self->{sections}->[1] = { position => length($self->{content}), size => length($$string) - 1, type => "$self->{separator}$self->{separator}", }; } else { # No sections at all $self->{_sections} = 1; } $self->{content} .= $$string; return 0; } # Complete the properties of the second section $self->{sections}->[1] = { position => length($self->{content}), size => length($string) - 1 }; $self->{content} .= $string; 1; } # Handle content parsing for matching brace separated sub _fill_braced { my $self = shift; my $t = shift; # Get the content up to the close character my $section = $self->{sections}->[0]; my $brace_str = $self->_scan_for_brace_character( $t, $section->{_close} ); return undef unless defined $brace_str; if ( ref $brace_str ) { # End of file if ( length($$brace_str) > 1 ) { # Complete the properties for the first section my $str = $$brace_str; chop $str; $self->{sections}->[0] = { position => length($self->{content}), size => length($$brace_str) - 1, type => $section->{type}, }; $self->{_sections} = 1; } else { # No sections at all $self->{sections} = [ ]; $self->{_sections} = 0; } $self->{content} .= $$brace_str; return 0; } # Complete the properties of the first section $section->{position} = length $self->{content}; $section->{size} = length($brace_str) - 1; $self->{content} .= $brace_str; delete $section->{_close}; # We are done if there is only one section return 1 if $self->{_sections} == 1; # There are two sections. # Is there a gap between the sections. my $char = substr( $t->{line}, ++$t->{line_cursor}, 1 ); if ( $char =~ /\s/ ) { # Go past the gap my $gap_str = $self->_scan_quote_like_operator_gap( $t ); return undef unless defined $gap_str; if ( ref $gap_str ) { # End of file $self->{content} .= $$gap_str; return 0; } $self->{content} .= $gap_str; $char = substr( $t->{line}, $t->{line_cursor}, 1 ); } $section = $SECTIONS{$char}; if ( $section ) { # It's a brace # Initialize the second section $self->{content} .= $char; $section = { %$section }; # Advance into the second section $t->{line_cursor}++; # Get the content up to the close character $brace_str = $self->_scan_for_brace_character( $t, $section->{_close} ); return undef unless defined $brace_str; if ( ref $brace_str ) { # End of file if ( length($$brace_str) > 1 ) { # Complete the properties for the second section my $str = $$brace_str; chop $str; $self->{sections}->[1] = { position => length($self->{content}), size => length($$brace_str) - 1, type => $section->{type}, }; $self->{_sections} = 2; } else { # No sections at all $self->{_sections} = 1; } $self->{content} .= $$brace_str; return 0; } else { # Complete the properties for the second section $self->{sections}->[1] = { position => length($self->{content}), size => length($brace_str) - 1, type => $section->{type}, }; $self->{content} .= $brace_str; } } elsif ( $char =~ m/ \A [^\w\s] \z /smx ) { # It is some other delimiter (weird, but possible) # Add the delimiter to the content. $self->{content} .= $char; # Advance into the next section $t->{line_cursor}++; # Get the content up to the end separator my $string = $self->_scan_for_unescaped_character( $t, $char ); return undef unless defined $string; if ( ref $string ) { # End of file if ( length($$string) > 1 ) { # Complete the properties for the second section my $str = $$string; chop $str; $self->{sections}->[1] = { position => length($self->{content}), size => length($$string) - 1, type => "$char$char", }; } else { # Only the one section $self->{_sections} = 1; } $self->{content} .= $$string; return 0; } # Complete the properties of the second section $self->{sections}->[1] = { position => length($self->{content}), size => length($string) - 1, type => "$char$char", }; $self->{content} .= $string; } else { # Error, it has to be a delimiter of some sort. # Although this will result in a REALLY illegal regexp, # we allow it anyway. # Create a null second section $self->{sections}->[1] = { position => length($self->{content}), size => 0, type => '', }; # Attach an error to the token and move on $self->{_error} = "No second section of regexp, or does not start with a balanced character"; # Roll back the cursor one char and return signalling end of regexp $t->{line_cursor}--; return 0; } 1; } ##################################################################### # Additional methods to find out about the quote # In a scalar context, get the number of sections # In an array context, get the section information sub _sections { wantarray ? @{$_[0]->{sections}} : scalar @{$_[0]->{sections}} } # Get a section's content sub _section_content { my $self = shift; my $i = shift; $self->{sections} or return; my $section = $self->{sections}->[$i] or return; return substr( $self->content, $section->{position}, $section->{size} ); } # Get the modifiers if any. # In list context, return the modifier hash. # In scalar context, clone the hash and return a reference to it. # If there are no modifiers, simply return. sub _modifiers { my $self = shift; $self->{modifiers} or return; wantarray and return %{ $self->{modifiers} }; return +{ %{ $self->{modifiers} } }; } # Get the delimiters, or at least give it a good try to get them. sub _delimiters { my $self = shift; $self->{sections} or return; my @delims; foreach my $sect ( @{ $self->{sections} } ) { if ( exists $sect->{type} ) { push @delims, $sect->{type}; } else { my $content = $self->content; push @delims, substr( $content, $sect->{position} - 1, 1 ) . substr( $content, $sect->{position} + $sect->{size}, 1 ); } } return @delims; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/_QuoteEngine/Simple.pm0000644000175000017500000000253014573465137017255 0ustar olafolafpackage PPI::Token::_QuoteEngine::Simple; # Simple quote engine use strict; use PPI::Token::_QuoteEngine (); our $VERSION = '1.278'; our @ISA = 'PPI::Token::_QuoteEngine'; sub new { my $class = shift; my $separator = shift or return undef; # Create a new token containing the separator ### This manual SUPER'ing ONLY works because none of ### Token::Quote, Token::QuoteLike and Token::Regexp ### implement a new function of their own. my $self = PPI::Token::new( $class, $separator ) or return undef; $self->{separator} = $separator; $self; } sub _fill { my $class = shift; my $t = shift; my $self = $t->{token} or return undef; # Scan for the end separator my $string = $self->_scan_for_unescaped_character( $t, $self->{separator} ); return undef unless defined $string; if ( ref $string ) { # End of file $self->{content} .= $$string; return 0; } else { # End of string $self->{content} .= $string; return $self; } } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/DashedWord.pm0000644000175000017500000000365714573465137015501 0ustar olafolafpackage PPI::Token::DashedWord; =pod =head1 NAME PPI::Token::DashedWord - A dashed bareword token =head1 INHERITANCE PPI::Token::DashedWord isa PPI::Token isa PPI::Element =head1 DESCRIPTION The "dashed bareword" token represents literal values like C<-foo>. NOTE: this class is currently unused. All tokens that should be PPI::Token::DashedWords are just normal PPI::Token::Word instead. That actually makes sense, since there really is nothing special about this class except that dashed words cannot be subroutine names or keywords. As such, this class may be removed from PPI in the future. =head1 METHODS =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; =pod =head2 literal Returns the value of the dashed word as a string. This differs from C because C<-Foo'Bar> expands to C<-Foo::Bar>. =cut *literal = *PPI::Token::Word::literal; ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { my $t = $_[1]; # Suck to the end of the dashed bareword pos $t->{line} = $t->{line_cursor}; if ( $t->{line} =~ m/\G(\w+)/gc ) { $t->{token}->{content} .= $1; $t->{line_cursor} += length $1; } # Are we a file test operator? if ( $t->{token}->{content} =~ /^\-[rwxoRWXOezsfdlpSbctugkTBMAC]$/ ) { # File test operator $t->{class} = $t->{token}->set_class( 'Operator' ); } else { # No, normal dashed bareword $t->{class} = $t->{token}->set_class( 'Word' ); } $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Whitespace.pm0000644000175000017500000002732614573465137015550 0ustar olafolafpackage PPI::Token::Whitespace; =pod =head1 NAME PPI::Token::Whitespace - Tokens representing ordinary white space =head1 INHERITANCE PPI::Token::Whitespace isa PPI::Token isa PPI::Element =head1 DESCRIPTION As a full "round-trip" parser, PPI records every last byte in a file and ensure that it is included in the L object. This even includes whitespace. In fact, Perl documents are seen as "floating in a sea of whitespace", and thus any document will contain vast quantities of C objects. For the most part, you shouldn't notice them. Or at least, you shouldn't B to notice them. This means doing things like consistently using the "S for significant" series of L and L methods to do things. If you want the nth child element, you should be using C rather than C, and likewise C, C, and so on and so forth. =head1 METHODS Again, for the most part you should really B need to do anything very significant with whitespace. But there are a couple of convenience methods provided, beyond those provided by the parent L and L classes. =cut use strict; use Clone (); use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; =pod =head2 null Because L sees documents as sitting on a sort of substrate made of whitespace, there are a couple of corner cases that get particularly nasty if they don't find whitespace in certain places. Imagine walking down the beach to go into the ocean, and then quite unexpectedly falling off the side of the planet. Well it's somewhat equivalent to that, including the whole screaming death bit. The C method is a convenience provided to get some internals out of some of these corner cases. Specifically it create a whitespace token that represents nothing, or at least the null string C<''>. It's a handy way to have some "whitespace" right where you need it, without having to have any actual characters. =cut my $null; sub null { $null ||= $_[0]->new(''); Clone::clone($null); } ### XS -> PPI/XS.xs:_PPI_Token_Whitespace__significant 0.900+ sub significant() { '' } =pod =head2 tidy C is a convenience method for removing unneeded whitespace. Specifically, it removes any whitespace from the end of a line. Note that this B include POD, where you may well need to keep certain types of whitespace. The entire POD chunk lives in its own L object. =cut sub tidy { $_[0]->{content} =~ s/^\s+?(?>\n)//; 1; } ##################################################################### # Parsing Methods # Build the class and commit maps my %COMMITMAP = ( map( { ord $_ => 'PPI::Token::Word' } 'a' .. 'u', 'A' .. 'Z', qw" w y z _ " ), # no v or x map( { ord $_ => 'PPI::Token::Structure' } qw" ; [ ] { } ) " ), ord '#' => 'PPI::Token::Comment', ord 'v' => 'PPI::Token::Number::Version', ); my %CLASSMAP = ( map( { ord $_ => 'Number' } 0 .. 9 ), map( { ord $_ => 'Operator' } qw" = ? | + > . ! ~ ^ " ), map( { ord $_ => 'Unknown' } qw" * $ @ & : % " ), ord ',' => 'PPI::Token::Operator', ord "'" => 'Quote::Single', ord '"' => 'Quote::Double', ord '`' => 'QuoteLike::Backtick', ord '\\' => 'Cast', ord '_' => 'Word', 9 => 'Whitespace', # A horizontal tab 10 => 'Whitespace', # A newline 12 => 'Whitespace', # A form feed 13 => 'Whitespace', # A carriage return 32 => 'Whitespace', # A normal space ); # Words (functions and keywords) after which a following / is # almost certainly going to be a regex my %MATCHWORD = map { $_ => 1 } qw{ return split if unless grep map }; sub __TOKENIZER__on_line_start { my $t = $_[1]; my $line = $t->{line}; # Can we classify the entire line in one go if ( $line =~ /^\s*$/ ) { # A whitespace line $t->_new_token( 'Whitespace', $line ); return 0; } elsif ( $line =~ /^\s*#/ ) { # A comment line $t->_new_token( 'Comment', $line ); $t->_finalize_token; return 0; } elsif ( $line =~ /^=(\w+)/ ) { # A Pod tag... change to pod mode $t->_new_token( 'Pod', $line ); if ( $1 eq 'cut' ) { # This is an error, but one we'll ignore # Don't go into Pod mode, since =cut normally # signals the end of Pod mode } else { $t->{class} = 'PPI::Token::Pod'; } return 0; } elsif ( $line =~ /^use v6\-alpha\;/ ) { # Indicates a Perl 6 block. Make the initial # implementation just suck in the entire rest of the # file. my @perl6; while ( 1 ) { my $line6 = $t->_get_line; last unless defined $line6; push @perl6, $line6; } push @{ $t->{perl6} }, join '', @perl6; # We only sucked in the block, we don't actually do # anything to the "use v6..." line. So return as if # we didn't find anything at all. return 1; } 1; } sub __TOKENIZER__on_char { my $t = $_[1]; my $c = substr $t->{line}, $t->{line_cursor}, 1; my $char = ord $c; # Do we definitely know what something is? return $COMMITMAP{$char}->__TOKENIZER__commit($t) if $COMMITMAP{$char}; # Handle the simple option first return $CLASSMAP{$char} if $CLASSMAP{$char}; if ( $char == 40 ) { # $char eq '(' # Finalise any whitespace token... $t->_finalize_token if $t->{token}; # Is this the beginning of a sub prototype? # We are a sub prototype IF # 1. The previous significant token is a bareword. # 2. The one before that is the word 'sub'. # 3. The one before that is a 'structure' # Get the three previous significant tokens my @tokens = $t->_previous_significant_tokens(3); # A normal subroutine declaration my $p1 = $tokens[1]; my $p2 = $tokens[2]; if ( $tokens[0] and $tokens[0]->isa('PPI::Token::Word') and $p1 and $p1->isa('PPI::Token::Word') and $p1->content eq 'sub' and ( not $p2 or $p2->isa('PPI::Token::Structure') or ( $p2->isa('PPI::Token::Whitespace') and $p2->content eq '' ) or ( # Lexical subroutine $p2->isa('PPI::Token::Word') and $p2->content =~ /^(?:my|our|state)$/ ) ) ) { # This is a sub prototype return 'Prototype'; } # A prototyped anonymous subroutine my $p0 = $tokens[0]; if ( $p0 and $p0->isa('PPI::Token::Word') and $p0->content eq 'sub' # Maybe it's invoking a method named 'sub' and not ( $p1 and $p1->isa('PPI::Token::Operator') and $p1->content eq '->') ) { return 'Prototype'; } # This is a normal open bracket return 'Structure'; } elsif ( $char == 60 ) { # $char eq '<' # Finalise any whitespace token... $t->_finalize_token if $t->{token}; # This is either "less than" or "readline quote-like" # Do some context stuff to guess which. my $prev = $t->_last_significant_token; # The most common group of less-thans are used like # $foo < $bar # 1 < $bar # $#foo < $bar return 'Operator' if $prev and $prev->isa('PPI::Token::Symbol'); return 'Operator' if $prev and $prev->isa('PPI::Token::Magic'); return 'Operator' if $prev and $prev->isa('PPI::Token::Number'); return 'Operator' if $prev and $prev->isa('PPI::Token::ArrayIndex'); # If it is <<... it's a here-doc instead my $next_char = substr( $t->{line}, $t->{line_cursor} + 1, 2 ); return 'Operator' if $next_char =~ /<[^>]/; return 'Operator' if not $prev; # The most common group of readlines are used like # while ( <...> ) # while <>; my $prec = $prev->content; return 'QuoteLike::Readline' if ( $prev->isa('PPI::Token::Structure') and $prec eq '(' ) or ( $prev->isa('PPI::Token::Structure') and $prec eq ';' ) or ( $prev->isa('PPI::Token::Word') and $prec eq 'while' ) or ( $prev->isa('PPI::Token::Operator') and $prec eq '=' ) or ( $prev->isa('PPI::Token::Operator') and $prec eq ',' ); if ( $prev->isa('PPI::Token::Structure') and $prec eq '}' ) { # Could go either way... do a regex check # $foo->{bar} < 2; # grep { .. } ; pos $t->{line} = $t->{line_cursor}; if ( $t->{line} =~ m/\G<(?!\d)\w+>/gc ) { # Almost definitely readline return 'QuoteLike::Readline'; } } # Otherwise, we guess operator, which has been the default up # until this more comprehensive section was created. return 'Operator'; } elsif ( $char == 47 ) { # $char eq '/' # Finalise any whitespace token... $t->_finalize_token if $t->{token}; # This is either a "divided by" or a "start regex" # Do some context stuff to guess ( ack ) which. # Hopefully the guess will be good enough. my $prev = $t->_last_significant_token; # Or as the very first thing in a file return 'Regexp::Match' if not $prev; my $prec = $prev->content; # Most times following an operator, we are a regex. # This includes cases such as: # , - As an argument in a list # .. - The second condition in a flip flop # =~ - A bound regex # !~ - Ditto return 'Regexp::Match' if $prev->isa('PPI::Token::Operator'); # After a symbol return 'Operator' if $prev->isa('PPI::Token::Symbol'); if ( $prec eq ']' and $prev->isa('PPI::Token::Structure') ) { return 'Operator'; } # After another number return 'Operator' if $prev->isa('PPI::Token::Number'); # After going into scope/brackets if ( $prev->isa('PPI::Token::Structure') and ( $prec eq '(' or $prec eq '{' or $prec eq ';' ) ) { return 'Regexp::Match'; } # Functions and keywords if ( $MATCHWORD{$prec} and $prev->isa('PPI::Token::Word') ) { return 'Regexp::Match'; } # What about the char after the slash? There's some things # that would be highly illogical to see if it's an operator. my $next_char = substr $t->{line}, $t->{line_cursor} + 1, 1; if ( defined $next_char and length $next_char ) { if ( $next_char =~ /(?:\^|\[|\\)/ ) { return 'Regexp::Match'; } } # Otherwise... erm... assume operator? # Add more tests here as potential cases come to light return 'Operator'; } elsif ( $char == 120 ) { # $char eq 'x' # Could be a word, the x= operator, the x operator # followed by whitespace, or the x operator without any # space between itself and its operand, e.g.: '$a x3', # which is the same as '$a x 3'. _current_x_is_operator # assumes we have a complete 'x' token, but we don't # yet. We may need to split this x character apart from # what follows it. if ( $t->_current_x_is_operator ) { pos $t->{line} = $t->{line_cursor} + 1; return 'Operator' if $t->{line} =~ m/\G(?: \d # x op with no whitespace e.g. 'x3' | (?!( # negative lookahead => # not on left of fat comma | \w # not a word like "xyzzy" | \s # not x op plus whitespace )) )/gcx; } # Otherwise, commit like a normal bareword, including x # operator followed by whitespace. return PPI::Token::Word->__TOKENIZER__commit($t); } elsif ( $char == 45 ) { # $char eq '-' # Look for an obvious operator operand context my $context = $t->_opcontext; if ( $context eq 'operator' ) { return 'Operator'; } else { # More logic needed return 'Unknown'; } } elsif ( $char >= 128 ) { # Outside ASCII return 'PPI::Token::Word'->__TOKENIZER__commit($t) if $c =~ /\w/; return 'Whitespace' if $c =~ /\s/; } # All the whitespaces are covered, so what to do ### For now, die PPI::Exception->throw("Encountered unexpected character '$char'"); } sub __TOKENIZER__on_line_end { $_[1]->_finalize_token if $_[1]->{token}; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Cast.pm0000644000175000017500000000330614573465137014336 0ustar olafolafpackage PPI::Token::Cast; =pod =head1 NAME PPI::Token::Cast - A prefix which forces a value into a different context =head1 INHERITANCE PPI::Token::Cast isa PPI::Token isa PPI::Element =head1 DESCRIPTION A "cast" in PPI terms is one of more characters used as a prefix which force a value into a different class or context. This includes referencing, dereferencing, and a few other minor cases. For expressions such as C<@$foo> or C<@{ $foo{bar} }> the C<@> in both cases represents a cast. In this case, an array dereference. =head1 METHODS There are no additional methods beyond those provided by the parent L and L classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; our %POSTFIX = map { $_ => 1 } ( qw{ %* @* $* }, '$#*' # throws warnings if it's inside a qw ); ##################################################################### # Tokenizer Methods # A cast is either % @ $ or $# # and also postfix dereference are %* @* $* $#* sub __TOKENIZER__on_char { my $t = $_[1]; my $char = substr( $t->{line}, $t->{line_cursor}, 1 ); # Are we still an operator if we add the next character my $content = $t->{token}->{content}; return 1 if $POSTFIX{ $content . $char }; $t->_finalize_token->__TOKENIZER__on_char( $t ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Pod.pm0000644000175000017500000000602714573465137014171 0ustar olafolafpackage PPI::Token::Pod; =pod =head1 NAME PPI::Token::Pod - Sections of POD in Perl documents =head1 INHERITANCE PPI::Token::Pod isa PPI::Token isa PPI::Element =head1 DESCRIPTION A single C object represents a complete section of POD documentation within a Perl document. =head1 METHODS This class provides some additional methods beyond those provided by its L and L parent classes. =cut use strict; use Params::Util qw{_INSTANCE}; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # PPI::Token::Pod Methods =pod =head2 merge @podtokens The C constructor takes a number of C objects, and returns a new object that represents one combined POD block with the content of all of them. Returns a new C object, or C on error. =cut sub merge { my $class = (! ref $_[0]) ? shift : return undef; # Check there are no bad arguments if ( grep { ! _INSTANCE($_, 'PPI::Token::Pod') } @_ ) { return undef; } # Get the tokens, and extract the lines my @content = ( map { [ $_->lines ] } @_ ) or return undef; # Remove the leading =pod tags, trailing =cut tags, and any empty lines # between them and the pod contents. foreach my $pod ( @content ) { # Leading =pod tag if ( @$pod and $pod->[0] =~ /^=pod\b/o ) { shift @$pod; } # Trailing =cut tag if ( @$pod and $pod->[-1] =~ /^=cut\b/o ) { pop @$pod; } # Leading and trailing empty lines while ( @$pod and $pod->[0] eq '' ) { shift @$pod } while ( @$pod and $pod->[-1] eq '' ) { pop @$pod } } # Remove any empty pod sections, and add the =pod and =cut tags # for the merged pod back to it. @content = ( [ '=pod' ], grep { @$_ } @content, [ '=cut' ] ); # Create the new object $class->new( join "\n", map { join( "\n", @$_ ) . "\n" } @content ); } =pod =head2 lines The C method takes the string of POD and breaks it into lines, returning them as a list. =cut sub lines { split /(?:\015{1,2}\012|\015|\012)/, $_[0]->{content}; } ##################################################################### # PPI::Element Methods ### XS -> PPI/XS.xs:_PPI_Token_Pod__significant 0.900+ sub significant() { '' } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_line_start { my $t = $_[1]; # Add the line to the token first $t->{token}->{content} .= $t->{line}; # Check the line to see if it is a =cut line if ( $t->{line} =~ /^=(\w+)/ ) { # End of the token $t->_finalize_token if $1 eq 'cut'; } 0; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/QuoteLike.pm0000644000175000017500000000311714573465137015346 0ustar olafolafpackage PPI::Token::QuoteLike; =pod =head1 NAME PPI::Token::QuoteLike - Quote-like operator abstract base class =head1 INHERITANCE PPI::Token::QuoteLike isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is never instantiated, and simply provides a common abstract base class for the five quote-like operator classes. In PPI, a "quote-like" is the set of quote-like things that exclude the string quotes and regular expressions. The subclasses of C are: =over 2 =item qw{} - L =item `` - L =item qx{} - L =item qr// - L =item - L =back The names are hopefully obvious enough not to have to explain what each class is. See their pages for more details. You may note that the backtick and command quote-like are treated separately, even though they do the same thing. This is intentional, as the inherit from and are processed by two different parts of the PPI's quote engine. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Magic.pm0000644000175000017500000001307114573465137014464 0ustar olafolafpackage PPI::Token::Magic; =pod =head1 NAME PPI::Token::Magic - Tokens representing magic variables =head1 INHERITANCE PPI::Token::Magic isa PPI::Token::Symbol isa PPI::Token isa PPI::Element =head1 SYNOPSIS # When we say magic variables, we mean these... $1 $2 $3 $4 $5 $6 $7 $8 $9 $_ $& $` $' $+ @+ %+ $* $. $/ $| $\ $" $; $% $= $- @- %- $) $# $~ $^ $: $? $! %! $@ $$ $< $> $( $0 $[ $] @_ @* $} $, $#+ $#- $^L $^A $^E $^C $^D $^F $^H $^I $^M $^N $^O $^P $^R $^S $^T $^V $^W $^X %^H =head1 DESCRIPTION C is a sub-class of L which identifies the token as "magic variable", one of the strange and unusual variables that are connected to "things" behind the scenes. Some are extremely common, like C<$_>, and others you will quite probably never encounter in your Perl career. =head1 METHODS The class provides no additional methods, beyond those provided by L, L and L. =cut use strict; use PPI::Token::Symbol (); use PPI::Token::Unknown (); use PPI::Singletons qw' %MAGIC $CURLY_SYMBOL '; our $VERSION = '1.278'; our @ISA = "PPI::Token::Symbol"; sub __TOKENIZER__on_char { my $t = $_[1]; # $c is the candidate new content my $c = $t->{token}->{content} . substr( $t->{line}, $t->{line_cursor}, 1 ); # Do a quick first test so we don't have to do more than this one. # All of the tests below match this one, so it should provide a # small speed up. This regex should be updated to match the inside # tests if they are changed. if ( $c =~ /^ \$ .* [ \w : \$ \{ ] $/x ) { if ( $c =~ /^(\$(?:\_[\w:]|::))/ or $c =~ /^\$\'[\w]/ ) { # If and only if we have $'\d, it is not a # symbol. (this was apparently a conscious choice) # Note that $::0 on the other hand is legal if ( $c =~ /^\$\'\d$/ ) { # In this case, we have a magic plus a digit. # Save the CURRENT token, and rerun the on_char return $t->_finalize_token->__TOKENIZER__on_char( $t ); } # A symbol in the style $_foo or $::foo or $'foo. # Overwrite the current token $t->{class} = $t->{token}->set_class('Symbol'); return PPI::Token::Symbol->__TOKENIZER__on_char( $t ); } if ( $c =~ /^\$\$\w/ ) { # This is really a scalar dereference. ( $$foo ) # Add the current token as the cast... $t->{token} = PPI::Token::Cast->new( '$' ); $t->_finalize_token; # ... and create a new token for the symbol return $t->_new_token( 'Symbol', '$' ); } if ( $c eq '$${' ) { # This _might_ be a dereference of one of the # control-character symbols. pos $t->{line} = $t->{line_cursor} + 1; if ( $t->{line} =~ m/$CURLY_SYMBOL/gc ) { # This is really a dereference. ( $${^_foo} ) # Add the current token as the cast... $t->{token} = PPI::Token::Cast->new( '$' ); $t->_finalize_token; # ... and create a new token for the symbol return $t->_new_token( 'Magic', '$' ); } } if ( $c eq '$#$' or $c eq '$#{' ) { # This is really an index dereferencing cast, although # it has the same two chars as the magic variable $#. $t->{class} = $t->{token}->set_class('Cast'); return $t->_finalize_token->__TOKENIZER__on_char( $t ); } if ( $c =~ /^(\$\#)\w/ ) { # This is really an array index thingy ( $#array ) $t->{token} = PPI::Token::ArrayIndex->new( "$1" ); return PPI::Token::ArrayIndex->__TOKENIZER__on_char( $t ); } if ( $c =~ /^\$\^\w+$/o ) { # It's an escaped char magic... maybe ( like $^M ) my $next = substr( $t->{line}, $t->{line_cursor}+1, 1 ); # Peek ahead if ($MAGIC{$c} && (!$next || $next !~ /\w/)) { $t->{token}->{content} = $c; $t->{line_cursor}++; } else { # Maybe it's a long magic variable like $^WIDE_SYSTEM_CALLS return 1; } } if ( $c =~ /^\$\#\{/ ) { # The $# is actually a cast, and { is its block # Add the current token as the cast... $t->{token} = PPI::Token::Cast->new( '$#' ); $t->_finalize_token; # ... and create a new token for the block return $t->_new_token( 'Structure', '{' ); } } elsif ($c =~ /^%\^/) { return 1 if $c eq '%^'; # It's an escaped char magic... maybe ( like %^H ) if ($MAGIC{$c}) { $t->{token}->{content} = $c; $t->{line_cursor}++; } else { # Back off, treat '%' as an operator chop $t->{token}->{content}; bless $t->{token}, $t->{class} = 'PPI::Token::Operator'; $t->{line_cursor}--; } } if ( $MAGIC{$c} ) { # $#+ and $#- $t->{line_cursor} += length( $c ) - length( $t->{token}->{content} ); $t->{token}->{content} = $c; } else { pos $t->{line} = $t->{line_cursor}; if ( $t->{line} =~ m/($CURLY_SYMBOL)/gc ) { # control character symbol (e.g. ${^MATCH}) $t->{token}->{content} .= $1; $t->{line_cursor} += length $1; } elsif ( $c =~ /^\$\d+$/ and $t->{line} =~ /\G(\d+)/gc ) { # Grab trailing digits of regex capture variables. $t->{token}{content} .= $1; $t->{line_cursor} += length $1; } } # End the current magic token, and recheck $t->_finalize_token->__TOKENIZER__on_char( $t ); } # Our version of canonical is plain simple sub canonical { $_[0]->content } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Structure.pm0000644000175000017500000001127714573465137015452 0ustar olafolafpackage PPI::Token::Structure; =pod =head1 NAME PPI::Token::Structure - Token class for characters that define code structure =head1 INHERITANCE PPI::Token::Structure isa PPI::Token isa PPI::Element =head1 DESCRIPTION The C class is used for tokens that control the general tree structure or code. This consists of seven characters. These are the six brace characters from the "round", "curly" and "square" pairs, plus the semi-colon statement separator C<;>. =head1 METHODS This class has no methods beyond what is provided by its L and L parent classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; # Set the matching braces, done as an array # for slightly faster lookups. my %MATCH = ( ord '{' => '}', ord '}' => '{', ord '[' => ']', ord ']' => '[', ord '(' => ')', ord ')' => '(', ); my %OPENS = ( ord '{' => 1, ord '[' => 1, ord '(' => 1, ); my %CLOSES = ( ord '}' => 1, ord ']' => 1, ord ')' => 1, ); ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_char { # Structures are one character long, always. # Finalize and process again. $_[1]->_finalize_token->__TOKENIZER__on_char( $_[1] ); } sub __TOKENIZER__commit { my $t = $_[1]; $t->_new_token( 'Structure', substr( $t->{line}, $t->{line_cursor}, 1 ) ); $t->_finalize_token; 0; } ##################################################################### # Lexer Methods # For a given brace, find its opposing pair sub __LEXER__opposite { $MATCH{ord $_[0]->{content}}; } ##################################################################### # PPI::Element Methods # There is a unusual situation in regards to "siblings". # # As an Element, braces sit outside the normal tree structure, and in # this context they NEVER have siblings. # # However, as tokens they DO have siblings. # # As such, we need special versions of _all_ of the sibling methods to # handle this. # # Statement terminators do not have these problems, and for them sibling # calls work as normal, and so they can just be passed upwards. sub next_sibling { return $_[0]->SUPER::next_sibling if $_[0]->{content} eq ';'; return ''; } sub snext_sibling { return $_[0]->SUPER::snext_sibling if $_[0]->{content} eq ';'; return ''; } sub previous_sibling { return $_[0]->SUPER::previous_sibling if $_[0]->{content} eq ';'; return ''; } sub sprevious_sibling { return $_[0]->SUPER::sprevious_sibling if $_[0]->{content} eq ';'; return ''; } sub next_token { my $self = shift; return $self->SUPER::next_token if $self->{content} eq ';'; my $structure = $self->parent or return ''; # If this is an opening brace, descend down into our parent # structure, if it has children. if ( $OPENS{ ord $self->{content} } ) { my $child = $structure->child(0); if ( $child ) { # Decend deeper, or return if it is a token return $child->isa('PPI::Token') ? $child : $child->first_token; } elsif ( $structure->finish ) { # Empty structure, so next is closing brace return $structure->finish; } # Anything that slips through to here is a structure # with an opening brace, but no closing brace, so we # just have to go with it, and continue as we would # if we started with a closing brace. } # We can use the default implement, if we call it from the # parent structure of the closing brace. $structure->next_token; } sub previous_token { my $self = shift; return $self->SUPER::previous_token if $self->{content} eq ';'; my $structure = $self->parent or return ''; # If this is a closing brace, descend down into our parent # structure, if it has children. if ( $CLOSES{ ord $self->{content} } ) { my $child = $structure->child(-1); if ( $child ) { # Decend deeper, or return if it is a token return $child->isa('PPI::Token') ? $child : $child->last_token; } elsif ( $structure->start ) { # Empty structure, so next is closing brace return $structure->start; } # Anything that slips through to here is a structure # with a closing brace, but no opening brace, so we # just have to go with it, and continue as we would # if we started with an opening brace. } # We can use the default implement, if we call it from the # parent structure of the closing brace. $structure->previous_token; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Quote/0000775000175000017500000000000014573465137014203 5ustar olafolafPPI-1.278/lib/PPI/Token/Quote/Double.pm0000644000175000017500000000572014573465137015755 0ustar olafolafpackage PPI::Token::Quote::Double; =pod =head1 NAME PPI::Token::Quote::Double - A standard "double quote" token =head1 INHERITANCE PPI::Token::Quote::Double isa PPI::Token::Quote isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object represents a double-quoted interpolating string. The string is treated as a single entity, L will not try to understand what is in the string during the parsing process. =head1 METHODS There are several methods available for C, beyond those provided by the parent L, L and L classes. =cut use strict; use Params::Util qw{_INSTANCE}; use PPI::Token::Quote (); use PPI::Token::_QuoteEngine::Simple (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Simple PPI::Token::Quote }; ##################################################################### # PPI::Token::Quote::Double Methods =pod =head2 interpolations The interpolations method checks to see if the double quote actually contains any interpolated variables. Returns true if the string contains interpolations, or false if not. =cut # Upgrade: Return the interpolated substrings. # Upgrade: Returns parsed expressions. sub interpolations { # Are there any unescaped $things in the string !! ($_[0]->content =~ /(? method will, if possible, modify a simple double-quoted string token in place, turning it into the equivalent single-quoted string. If the token is modified, it is reblessed into the L package. Because the length of the content is not changed, there is no need to call the document's C method. The object itself is returned as a convenience. =cut sub simplify { # This only works on EXACTLY this class my $self = _INSTANCE(shift, 'PPI::Token::Quote::Double') or return undef; # Don't bother if there are characters that could complicate things my $content = $self->content; my $value = substr($content, 1, length($content) - 2); return $self if $value =~ /[\\\$@\'\"]/; # Change the token to a single string $self->{content} = "'$value'"; bless $self, 'PPI::Token::Quote::Single'; } ##################################################################### # PPI::Token::Quote Methods sub string { my $str = $_[0]->{content}; substr( $str, 1, length($str) - 2 ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Quote/Single.pm0000644000175000017500000000302514573465137015760 0ustar olafolafpackage PPI::Token::Quote::Single; =pod =head1 NAME PPI::Token::Quote::Single - A 'single quote' token =head1 INHERITANCE PPI::Token::Quote::Single isa PPI::Token::Quote isa PPI::Token isa PPI::Element =head1 SYNOPSIS 'This is a single quote' q{This is a literal, but NOT a single quote} =head1 DESCRIPTION A C object represents a single quoted string literal. =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::Quote (); use PPI::Token::_QuoteEngine::Simple (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Simple PPI::Token::Quote }; ##################################################################### # PPI::Token::Quote Methods sub string { my $str = $_[0]->{content}; substr( $str, 1, length($str) - 2 ); } my %UNESCAPE = ( "\\'" => "'", "\\\\" => "\\", ); sub literal { # Unescape \\ and \' ONLY my $str = $_[0]->string; $str =~ s/(\\.)/$UNESCAPE{$1} || $1/ge; return $str; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Quote/Literal.pm0000644000175000017500000000277114573465137016142 0ustar olafolafpackage PPI::Token::Quote::Literal; =pod =head1 NAME PPI::Token::Quote::Literal - The literal quote-like operator =head1 INHERITANCE PPI::Token::Quote::Literal isa PPI::Token::Quote isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object represents a single literal quote-like operator, such as C. =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::Quote (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::Quote }; ##################################################################### # PPI::Token::Quote Methods sub string { my $self = shift; my @sections = $self->_sections; return unless # my $str = $sections[0]; substr( $self->{content}, $str->{position}, $str->{size} ); } # Use the same implementation as another module *literal = *PPI::Token::Quote::Single::literal; 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/Quote/Interpolate.pm0000644000175000017500000000264114573465137017030 0ustar olafolafpackage PPI::Token::Quote::Interpolate; =pod =head1 NAME PPI::Token::Quote::Interpolate - The interpolation quote-like operator =head1 INHERITANCE PPI::Token::Quote::Interpolate isa PPI::Token::Quote isa PPI::Token isa PPI::Element =head1 DESCRIPTION A C object represents a single interpolation quote-like operator, such as C. =head1 METHODS There are no methods available for C beyond those provided by the parent L, L and L classes. =cut use strict; use PPI::Token::Quote (); use PPI::Token::_QuoteEngine::Full (); our $VERSION = '1.278'; our @ISA = qw{ PPI::Token::_QuoteEngine::Full PPI::Token::Quote }; ##################################################################### # PPI::Token::Quote Methods sub string { my $self = shift; my @sections = $self->_sections; my $str = $sections[0]; substr( $self->{content}, $str->{position}, $str->{size} ); } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token/End.pm0000644000175000017500000000460114573465137014151 0ustar olafolafpackage PPI::Token::End; =pod =head1 NAME PPI::Token::End - Completely useless content after the __END__ tag =head1 INHERITANCE PPI::Token::End isa PPI::Token isa PPI::Element =head1 DESCRIPTION If you've read L, you should understand by now the concept of documents "floating in a sea of PPI::Token::Whitespace". Well it doesn't after the __END__ tag. Once you __END__, it's all over. Anything after that tag isn't even fit to be called whitespace. It just simply doesn't exist as far as perl (the interpreter) is concerned. That's not to say there isn't useful content. Most often people use the __END__ tag to hide POD content, so that perl never has to see it, and presumably providing some small speed up. That's fine. PPI likes POD. Any POD after the __END__ tag is parsed into valid L tags as normal. B class, on the other hand, is for "what's after __END__ when it isn't POD". Basically, the completely worthless bits of the file :) =head1 METHODS This class has no method beyond what is provided by its L and L parent classes. =cut use strict; use PPI::Token (); our $VERSION = '1.278'; our @ISA = "PPI::Token"; ##################################################################### # Tokenizer Methods ### XS -> PPI/XS.xs:_PPI_Token_End__significant 0.900+ sub significant() { '' } sub __TOKENIZER__on_char() { 1 } sub __TOKENIZER__on_line_start { my $t = $_[1]; # Can we classify the entire line in one go if ( $t->{line} =~ /^=(\w+)/ ) { # A Pod tag... change to pod mode $t->_new_token( 'Pod', $t->{line} ); unless ( $1 eq 'cut' ) { # Normal start to pod $t->{class} = 'PPI::Token::Pod'; } # This is an error, but one we'll ignore # Don't go into Pod mode, since =cut normally # signals the end of Pod mode } else { if ( defined $t->{token} ) { # Add to existing token $t->{token}->{content} .= $t->{line}; } else { $t->_new_token( 'End', $t->{line} ); } } 0; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Token.pm0000644000175000017500000001321714573465137013446 0ustar olafolafpackage PPI::Token; =pod =head1 NAME PPI::Token - A single token of Perl source code =head1 INHERITANCE PPI::Token isa PPI::Element =head1 DESCRIPTION C is the abstract base class for all Tokens. In PPI terms, a "Token" is a L that directly represents bytes of source code. =head1 METHODS =cut use strict; use Params::Util qw{_INSTANCE}; use PPI::Element (); use PPI::Exception (); our $VERSION = '1.278'; our @ISA = 'PPI::Element'; # We don't load the abstracts, they are loaded # as part of the inheritance process. # Load the token classes use PPI::Token::BOM (); use PPI::Token::Whitespace (); use PPI::Token::Comment (); use PPI::Token::Pod (); use PPI::Token::Number (); use PPI::Token::Number::Binary (); use PPI::Token::Number::Octal (); use PPI::Token::Number::Hex (); use PPI::Token::Number::Float (); use PPI::Token::Number::Exp (); use PPI::Token::Number::Version (); use PPI::Token::Word (); use PPI::Token::DashedWord (); use PPI::Token::Symbol (); use PPI::Token::ArrayIndex (); use PPI::Token::Magic (); use PPI::Token::Quote::Single (); use PPI::Token::Quote::Double (); use PPI::Token::Quote::Literal (); use PPI::Token::Quote::Interpolate (); use PPI::Token::QuoteLike::Backtick (); use PPI::Token::QuoteLike::Command (); use PPI::Token::QuoteLike::Regexp (); use PPI::Token::QuoteLike::Words (); use PPI::Token::QuoteLike::Readline (); use PPI::Token::Regexp::Match (); use PPI::Token::Regexp::Substitute (); use PPI::Token::Regexp::Transliterate (); use PPI::Token::Operator (); use PPI::Token::Cast (); use PPI::Token::Structure (); use PPI::Token::Label (); use PPI::Token::HereDoc (); use PPI::Token::Separator (); use PPI::Token::Data (); use PPI::Token::End (); use PPI::Token::Prototype (); use PPI::Token::Attribute (); use PPI::Token::Unknown (); ##################################################################### # Constructor and Related sub new { bless { content => (defined $_[1] ? "$_[1]" : '') }, $_[0]; } sub set_class { my $self = shift; # @_ or throw Exception("No arguments to set_class"); my $class = substr( $_[0], 0, 12 ) eq 'PPI::Token::' ? shift : 'PPI::Token::' . shift; # Find out if the current and new classes are complex my $old_quote = (ref($self) =~ /\b(?:Quote|Regex)\b/o) ? 1 : 0; my $new_quote = ($class =~ /\b(?:Quote|Regex)\b/o) ? 1 : 0; # No matter what happens, we will have to rebless bless $self, $class; # If we are changing to or from a Quote style token, we # can't just rebless and need to do some extra thing # Otherwise, we have done enough return $class if ($old_quote - $new_quote) == 0; # Make a new token from the old content, and overwrite the current # token's attributes with the new token's attributes. my $token = $class->new( $self->{content} ); %$self = %$token; # Return the class as a convenience return $class; } ##################################################################### # PPI::Token Methods =pod =head2 set_content $string The C method allows you to set/change the string that the C object represents. Returns the string you set the Token to =cut sub set_content { $_[0]->{content} = $_[1]; } =pod =head2 add_content $string The C method allows you to add additional bytes of code to the end of the Token. Returns the new full string after the bytes have been added. =cut sub add_content { $_[0]->{content} .= $_[1] } =pod =head2 length The C method returns the length of the string in a Token. =cut sub length { CORE::length($_[0]->{content}) } ##################################################################### # Overloaded PPI::Element methods sub content { $_[0]->{content}; } # You can insert either a statement, or a non-significant token. sub insert_before { my $self = shift; my $Element = _INSTANCE(shift, 'PPI::Element') or return undef; if ( $Element->isa('PPI::Structure') ) { return $self->__insert_before($Element); } elsif ( $Element->isa('PPI::Token') ) { return $self->__insert_before($Element); } ''; } # As above, you can insert a statement, or a non-significant token sub insert_after { my $self = shift; my $Element = _INSTANCE(shift, 'PPI::Element') or return undef; if ( $Element->isa('PPI::Structure') ) { return $self->__insert_after($Element); } elsif ( $Element->isa('PPI::Token') ) { return $self->__insert_after($Element); } ''; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_line_start() { 1 } sub __TOKENIZER__on_line_end() { 1 } sub __TOKENIZER__on_char() { 'Unknown' } ##################################################################### # Lexer Methods sub __LEXER__opens { ref($_[0]) eq 'PPI::Token::Structure' and $_[0]->{content} =~ /(?:\(|\[|\{)/ } sub __LEXER__closes { ref($_[0]) eq 'PPI::Token::Structure' and $_[0]->{content} =~ /(?:\)|\]|\})/ } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut PPI-1.278/lib/PPI/Statement.pm0000644000175000017500000002151014573465137014325 0ustar olafolafpackage PPI::Statement; =pod =head1 NAME PPI::Statement - The base class for Perl statements =head1 INHERITANCE PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION PPI::Statement is the root class for all Perl statements. This includes (from L) "Declarations", "Simple Statements" and "Compound Statements". The class PPI::Statement itself represents a "Simple Statement" as defined in the L manpage. =head1 STATEMENT CLASSES Please note that unless documented themselves, these classes are yet to be frozen/finalised. Names may change slightly or be added or removed. =head2 L This covers all "scheduled" blocks, chunks of code that are executed separately from the main body of the code, at a particular time. This includes all C, C, C, C and C blocks. =head2 L A package declaration, as defined in L. =head2 L A statement that loads or unloads another module. This includes 'use', 'no', and 'require' statements. =head2 L A named subroutine declaration, or forward declaration =head2 L A variable declaration statement. This could be either a straight declaration or also be an expression. This includes all 'my', 'state', 'local' and 'our' statements. =head2 L This covers the whole family of 'compound' statements, as described in L. This includes all statements starting with 'if', 'unless', 'for', 'foreach' and 'while'. Note that this does NOT include 'do', as it is treated differently. All compound statements have implicit ends. That is, they do not end with a ';' statement terminator. =head2 L A statement that breaks out of a structure. This includes all of 'redo', 'goto', 'next', 'last' and 'return' statements. =head2 L The kind of statement introduced in Perl 5.10 that starts with 'given'. This has an implicit end. =head2 L The kind of statement introduced in Perl 5.10 that starts with 'when' or 'default'. This also has an implicit end. =head2 L A special statement which encompasses an entire C<__DATA__> block, including the initial C<'__DATA__'> token itself and the entire contents. =head2 L A special statement which encompasses an entire __END__ block, including the initial '__END__' token itself and the entire contents, including any parsed PPI::Token::POD that may occur in it. =head2 L L is a little more speculative, and is intended to help represent the special rules relating to "expressions" such as in: # Several examples of expression statements # Boolean conditions if ( expression ) { ... } # Lists, such as for arguments Foo->bar( expression ) =head2 L A null statement is a special case for where we encounter two consecutive statement terminators. ( ;; ) The second terminator is given an entire statement of its own, but one that serves no purpose. Hence a 'null' statement. Theoretically, assuming a correct parsing of a perl file, all null statements are superfluous and should be able to be removed without damage to the file. But don't do that, in case PPI has parsed something wrong. =head2 L Because L is intended for use when parsing incorrect or incomplete code, the problem arises of what to do with a stray closing brace. Rather than die, it is allocated its own "unmatched brace" statement, which really means "unmatched closing brace". An unmatched open brace at the end of a file would become a structure with no contents and no closing brace. If the document loaded is intended to be correct and valid, finding a L in the PDOM is generally indicative of a misparse. =head2 L This is used temporarily mid-parsing to hold statements for which the lexer cannot yet determine what class it should be, usually because there are insufficient clues, or it might be more than one thing. You should never encounter these in a fully parsed PDOM tree. =head1 METHODS C itself has very few methods. Most of the time, you will be working with the more generic L or L methods, or one of the methods that are subclass-specific. =cut use strict; use Scalar::Util (); use Params::Util qw{_INSTANCE}; use PPI::Node (); use PPI::Exception (); use PPI::Singletons '%_PARENT'; our $VERSION = '1.278'; our @ISA = "PPI::Node"; use PPI::Statement::Break (); use PPI::Statement::Compound (); use PPI::Statement::Data (); use PPI::Statement::End (); use PPI::Statement::Expression (); use PPI::Statement::Include (); use PPI::Statement::Null (); use PPI::Statement::Package (); use PPI::Statement::Scheduled (); use PPI::Statement::Sub (); use PPI::Statement::Given (); use PPI::Statement::UnmatchedBrace (); use PPI::Statement::Unknown (); use PPI::Statement::Variable (); use PPI::Statement::When (); # "Normal" statements end at a statement terminator ; # Some are not, and need the more rigorous _continues to see # if we are at an implicit statement boundary. sub __LEXER__normal() { 1 } ##################################################################### # Constructor sub new { my $class = shift; if ( ref $class ) { PPI::Exception->throw; } # Create the object my $self = bless { children => [], }, $class; # If we have been passed what should be an initial token, add it my $token = shift; if ( _INSTANCE($token, 'PPI::Token') ) { # Inlined $self->__add_element(shift); Scalar::Util::weaken( $_PARENT{Scalar::Util::refaddr $token} = $self ); push @{$self->{children}}, $token; } $self; } =pod =head2 label One factor common to most statements is their ability to be labeled. The C