From 65db67c6e12087bf1ee97006905e9129d8aaaf02 Mon Sep 17 00:00:00 2001 From: Mike O'Regan Date: Thu, 27 Feb 2014 21:14:12 -0600 Subject: [PATCH] add cmp_document family of test functions ; reorg t/lib modules --- t/05_lexer.t | 5 +- t/07_token.t | 37 ++-- t/08_regression.t | 5 +- t/19_selftesting.t | 3 +- t/25_increment.t | 5 +- t/26_bom.t | 5 +- t/lib/PPI/Test.pm | 341 ++++++++++++++++++++++++++++++ t/lib/PPI/Test/Object.pm | 190 +++++++++++++++++ t/lib/{PPI.pm => PPI/Test/Run.pm} | 185 +--------------- t/lib/PPI/Test/pragmas.pm | 32 +++ 10 files changed, 602 insertions(+), 206 deletions(-) create mode 100644 t/lib/PPI/Test.pm create mode 100755 t/lib/PPI/Test/Object.pm rename t/lib/{PPI.pm => PPI/Test/Run.pm} (55%) mode change 100755 => 100644 create mode 100644 t/lib/PPI/Test/pragmas.pm diff --git a/t/05_lexer.t b/t/05_lexer.t index 8adab466..7b14732c 100644 --- a/t/05_lexer.t +++ b/t/05_lexer.t @@ -3,6 +3,7 @@ # Compare a large number of specific constructs # with the expected Lexer dumps. +use lib 't/lib'; use strict; BEGIN { no warnings 'once'; @@ -23,7 +24,7 @@ use PPI::Dumper; use Test::More tests => 219; use Test::NoWarnings; use File::Spec::Functions ':ALL'; -use t::lib::PPI; +use PPI::Test::Run; @@ -33,4 +34,4 @@ use t::lib::PPI; # Code/Dump Testing # ntests = 2 + 15 * nfiles -t::lib::PPI->run_testdir( catdir( 't', 'data', '05_lexer' ) ); +PPI::Test::Run->run_testdir( catdir( 't', 'data', '05_lexer' ) ); diff --git a/t/07_token.t b/t/07_token.t index 4d5e803d..89fee72b 100644 --- a/t/07_token.t +++ b/t/07_token.t @@ -2,6 +2,7 @@ # Formal unit tests for specific PPI::Token classes +use lib 't/lib'; use strict; BEGIN { no warnings 'once'; @@ -10,11 +11,11 @@ BEGIN { $PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER}; } -# Execute the tests use Test::More tests => 447; use Test::NoWarnings; use File::Spec::Functions ':ALL'; -use t::lib::PPI; +use List::MoreUtils (); +use PPI::Test::Run; use PPI; @@ -25,7 +26,7 @@ use PPI; # Code/Dump Testing # ntests = 2 + 12 * nfiles -t::lib::PPI->run_testdir( catdir( 't', 'data', '07_token' ) ); +PPI::Test::Run->run_testdir( catdir( 't', 'data', '07_token' ) ); @@ -49,7 +50,7 @@ SCOPE: { '@::foo' => '@main::foo', '$foo::bar' => '$foo::bar', '$ foo\'bar' => '$foo::bar', - ); + ); while ( @symbols ) { my ($value, $canon) = ( shift(@symbols), shift(@symbols) ); my $Symbol = PPI::Token::Symbol->new( $value ); @@ -155,10 +156,11 @@ foreach my $code ( '08', '09', '0778', '0779' ) { 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'); + 'invalid octal number should trigger parse error'); is($token->literal, undef, "literal('$code') is undef"); } + BINARY: { my @tests = ( # Good binary numbers @@ -175,25 +177,26 @@ BINARY: { { 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"); + 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 @@ -233,6 +236,6 @@ HEX: { 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}"); + is($token->literal, $test->{value}, "literal('$code') is $test->{value}"); } } diff --git a/t/08_regression.t b/t/08_regression.t index 545bceb4..097c7ede 100644 --- a/t/08_regression.t +++ b/t/08_regression.t @@ -4,6 +4,7 @@ # Some other regressions tests are included here for simplicity. +use lib 't/lib'; use strict; BEGIN { no warnings 'once'; @@ -17,7 +18,7 @@ use Test::More tests => 933; use Test::NoWarnings; use File::Spec::Functions ':ALL'; use Params::Util qw{_INSTANCE}; -use t::lib::PPI; +use PPI::Test::Run; use PPI::Lexer; use PPI::Dumper; @@ -35,7 +36,7 @@ sub pause { # Code/Dump Testing # ntests = 2 + 14 * nfiles -t::lib::PPI->run_testdir(qw{ t data 08_regression }); +PPI::Test::Run->run_testdir(qw{ t data 08_regression }); diff --git a/t/19_selftesting.t b/t/19_selftesting.t index 6ceb98cf..d2b63cae 100644 --- a/t/19_selftesting.t +++ b/t/19_selftesting.t @@ -5,6 +5,7 @@ # Using PPI to analyse its own code at install-time? Fuck yeah! :) +use lib 't/lib'; use strict; BEGIN { no warnings 'once'; @@ -20,7 +21,7 @@ use File::Spec::Functions ':ALL'; use Params::Util qw{_CLASS _ARRAY _INSTANCE _IDENTIFIER}; use Class::Inspector; use PPI; -use t::lib::PPI; +use PPI::Test::Object; use constant CI => 'Class::Inspector'; diff --git a/t/25_increment.t b/t/25_increment.t index 205b9c7b..92237567 100644 --- a/t/25_increment.t +++ b/t/25_increment.t @@ -5,6 +5,7 @@ # 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 strict; BEGIN { no warnings 'once'; @@ -19,7 +20,7 @@ use File::Spec::Functions ':ALL'; use Params::Util qw{_INSTANCE}; use PPI::Lexer; use PPI::Dumper; -use t::lib::PPI; +use PPI::Test::Run; @@ -28,4 +29,4 @@ use t::lib::PPI; ##################################################################### # Code/Dump Testing -t::lib::PPI->increment_testdir(qw{ t data 08_regression }); +PPI::Test::Run->increment_testdir(qw{ t data 08_regression }); diff --git a/t/26_bom.t b/t/26_bom.t index 9b9a03e9..ba5d4cc0 100644 --- a/t/26_bom.t +++ b/t/26_bom.t @@ -1,5 +1,6 @@ #!/usr/bin/perl +use lib 't/lib'; use strict; BEGIN { no warnings 'once'; @@ -11,7 +12,7 @@ BEGIN { # For each new item in t/data/08_regression add another 14 tests use Test::More tests => 21; use Test::NoWarnings; -use t::lib::PPI; +use PPI::Test::Run; use PPI; @@ -22,4 +23,4 @@ use PPI; # Code/Dump Testing # ntests = 2 + 14 * nfiles -t::lib::PPI->run_testdir(qw{ t data 26_bom }); +PPI::Test::Run->run_testdir(qw{ t data 26_bom }); diff --git a/t/lib/PPI/Test.pm b/t/lib/PPI/Test.pm new file mode 100644 index 00000000..5d5f9ac2 --- /dev/null +++ b/t/lib/PPI/Test.pm @@ -0,0 +1,341 @@ +package PPI::Test; + +use warnings; +use strict; + +use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS}; +BEGIN { + $VERSION = '1.216_01'; + @ISA = 'Exporter'; + %EXPORT_TAGS = ( + 'cmp' => [ qw( + cmp_document cmp_sdocument + cmp_statement cmp_sstatement + cmp_element cmp_selement + ) ] + ); + @EXPORT_OK = ( map { @{ $EXPORT_TAGS{$_} } } keys %EXPORT_TAGS ); +} + +use Exporter (); +use List::MoreUtils (); +use List::Util (); +use Scalar::Util qw( blessed ); +use Test::More; + +=pod + +=head1 NAME + +PPI::Test - stuff to help with testing PPI + +=head1 TEST FUNCTIONS + +=head2 cmp_document( $code, \@expected [, $msg ] ) + +=head2 cmp_sdocument( $code, \@expected [, $msg ] ) + +Parses C into a new PPI::Document and checks the resulting +elements one by one against C, failing the test if the +two do not compare correctly. + +The variant C ignores insignificant elements in the +document so that you omit them from C. + +The contents of C dictate how the comparison is done. +Each element of C is a hashref that describes how to +compare it to the corresponding element from the parse. + +=over 4 + +=item class: + +The value of C is compared to the parsed element's class. + +=item isa: + +The value of C is passed to an isa call on parsed element. + +=item name of any method on the parsed PPI element: + +Any hash key not otherwise document is used as a method name on the parsed +element being compared, and the results must match the hash key's value. +If the element being compared does not have that method, the test +will fail. + +=item FUNC: + +The value for this attribute is a sub that accepts the parsed element +as its argument. Execute as many tests on anything you like in the +sub. E.g.: + + FUNC => sub { + my ( $elem, $msg ) = @_; + is_deeply( [$elem->foo()], [1, 2, 3], "$msg: testing foo" ); + } + +The return value of the sub is ignored. + +=item STOP: + +When the key STOP appears with a true value in a hash in C, +comparison stops after that hash has been compared. Test success or +failure is the result of that last comparison. + +=back + +The return is true for a successful test, false otherwise. + +=cut + +sub cmp_document { + my $code = shift; + my $expected = shift; + my $msg = shift; + local $Test::Builder::Level = $Test::Builder::Level + 1; + return _cmp_document( $code, $expected, $msg, 0 ); +} + +sub cmp_sdocument { + my $code = shift; + my $expected = shift; + my $msg = shift; + local $Test::Builder::Level = $Test::Builder::Level + 1; + return _cmp_document( $code, $expected, $msg, 1 ); +} + +sub _cmp_document { + my $code = shift; + my $expected = shift; + my $msg = shift; + my $significant_only = shift; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + $msg = 'cmp_document: ' . (defined $msg ? $msg : $code); + + return subtest $msg => sub { + my $doc = PPI::Document->new( \$code ); + + my $parsed = _as_array( $doc, { significant_only => $significant_only } ); + + my $iterator = List::MoreUtils::each_arrayref( $parsed, $expected ); + my $index = 0; + my $dump = 0; + while ( my ($elem, $want) = $iterator->() ) { + my $indexmsg = "[$index]:"; + if ( !defined $want ) { + $dump = !fail( "$indexmsg ran out of expected results for parsed element " . ref($elem) ) || $dump; + last; + } + if ( !defined $elem ) { + $dump = !fail( "$indexmsg ran out of parsed elements for expected result " . _hash_to_str($want) ) || $dump; + last; + } + $dump = !ok( blessed $elem, "$indexmsg parsed element is an object" ) || $dump; + + if ( exists $want->{class} ) { + $dump = !is( ref($elem), $want->{class}, "$indexmsg class matches" ) || $dump; + } + if ( exists $want->{isa} ) { + $dump = !isa_ok( $elem, $want->{isa}, "$indexmsg class " . ref($elem) . " isa $want->{isa}" ) || $dump; + } + foreach my $key ( keys %$want ) { + next if $key eq 'class' || $key eq 'isa' || $key eq 'STOP'; + if ( $elem->can($key) ) { + my $val = $elem->$key; + $dump = !is( $val, $want->{$key}, "$indexmsg $key matches" ) || $dump; + } + elsif ( $key eq 'FUNC' ) { + # Execute the caller's function, ignoring the return. + $want->{$key}->( $elem, "$indexmsg arbitrary tests" ); + } + else { + $dump = !fail( "$indexmsg no method $key on object of type " . ref($elem) ) || $dump; + } + } + + last if $dump; + last if $want->{STOP}; + + ++$index; + } + + if ( $dump ) { + _report_side_by_side( $parsed, $expected, $index ); + } + }; +} + + +sub _report_side_by_side { + my $parsed = shift; + my $expected = shift; + my $offending_index = shift; + + my $both_maxidx = List::Util::max( scalar(@$parsed)-1, scalar(@$expected)-1 ); + my $first_index = List::Util::max( $offending_index-4, 0 ); + my $last_index = List::Util::min( $offending_index+1, $both_maxidx ); + + my @parsed_descriptions = map { defined $parsed->[$_] ? ref $parsed->[$_] : '' } ( $first_index .. $last_index ); + my @expected_descriptions = map { defined $expected->[$_] ? _hash_to_str($expected->[$_]) : '' } ( $first_index .. $last_index ); + + my $parsed_max_len = List::Util::max map { length($_) } @parsed_descriptions; + my $expected_max_len = List::Util::max map { length($_) } @expected_descriptions; + my $last_index_len = length( $last_index ); + my @output; + for my $i ( $first_index .. $last_index ) { + push @output, + sprintf( + '%s [%*d] %-*s %-*s %s', + ($i == $offending_index ? '>>>' : ' '), + $last_index_len, $i, + $parsed_max_len, $parsed_descriptions[$i - $first_index], + $expected_max_len, $expected_descriptions[$i - $first_index], + ($i == $offending_index ? '<<<' : ' '), + ); + } + diag join( "\n", '', @output ); + + return; +} + + +=pod + +=head2 cmp_statement( $code, \@expected [, $msg ] ) + +=head2 cmp_statement( $code, \%expected [, $msg ] ) + +=head2 cmp_sstatement( $code, \@expected [, $msg ] ) + +=head2 cmp_sstatement( $code, \%expected [, $msg ] ) + +A convenience function that behaves like C, except that +you don't have to have a C element at the beginning of +C. + +The variant C ignores insignificant elements in the +document so that you omit them from C. + +C can be passed as a hashref if you have only one element to +compare. + +The return is true for a successful test, false otherwise. + +=cut + +sub cmp_statement { + my $code = shift; + my $expected = shift; + my $msg = shift; + local $Test::Builder::Level = $Test::Builder::Level + 1; + return _cmp_statement( $code, $expected, $msg, 0 ); +} + +sub cmp_sstatement { + my $code = shift; + my $expected = shift; + my $msg = shift; + local $Test::Builder::Level = $Test::Builder::Level + 1; + return _cmp_statement( $code, $expected, $msg, 1 ); +} + + +sub _cmp_statement { + my $code = shift; + my $expected = shift; + my $msg = shift; + my $significant_only = shift; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + $expected = [ $expected ] if ref( $expected ) ne 'ARRAY'; + $expected = [ { class => 'PPI::Document' }, @$expected ]; + + return _cmp_document( $code, $expected, $significant_only ); +} + + +=pod + +=head2 cmp_element( $code, \%expected [, $msg ] ) + +=head2 cmp_element( $code, \@expected [, $msg ] ) + +=head2 cmp_selement( $code, \%expected [, $msg ] ) + +=head2 cmp_selement( $code, \@expected [, $msg ] ) + +A convenience function that behaves like C, except that +C is a single hashref. The parsed document's initial +C and C are ignored, and comparison +begins with the element following the statement. + +You can also pass a listref of hashes for C, in which case +all elements in C must match. + +The variant C ignores insignificant elements in the +document so that you omit them from C. + +The return is true for a successful test, false otherwise. + +=cut + +sub cmp_element { + my $code = shift; + my $expected = shift; + my $msg = shift; + local $Test::Builder::Level = $Test::Builder::Level + 1; + return _cmp_element( $code, $expected, $msg, 0 ); +} + +sub cmp_selement { + my $code = shift; + my $expected = shift; + my $msg = shift; + local $Test::Builder::Level = $Test::Builder::Level + 1; + return _cmp_element( $code, $expected, $msg, 1 ); +} + +sub _cmp_element { + my $code = shift; + my $expected = shift; + my $msg = shift; + my $significant_only = shift; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + $expected = [ $expected ] if ref( $expected ) ne 'ARRAY'; + $expected = [ { class => 'PPI::Document' }, { isa => 'PPI::Statement' }, @$expected ]; + + return _cmp_document( $code, $expected, $msg, $significant_only ); +} + + +sub _as_array { + my $elem = shift; + my $opts = shift; + my $output = shift || []; + + if ( !$opts->{significant_only} || $elem->significant ) { + push @$output, $elem; + } + + # Recurse into our children + foreach my $child ( @{$elem->{children}} ) { + _as_array( $child, $opts, $output ); + } + + return $output; +} + + +sub _hash_to_str { + my $hash = shift; + my $str = '{ ' . join(', ', map { "$_ => $hash->{$_}" } keys %$hash) . ' }'; + return $str; +} + + +1; diff --git a/t/lib/PPI/Test/Object.pm b/t/lib/PPI/Test/Object.pm new file mode 100755 index 00000000..904d477d --- /dev/null +++ b/t/lib/PPI/Test/Object.pm @@ -0,0 +1,190 @@ +package PPI::Test::Object; + +use File::Spec::Functions ':ALL'; +use Test::More; +use Test::Object; +use Params::Util qw{_STRING _INSTANCE}; +use List::MoreUtils 'any'; + +use vars qw{$VERSION}; +BEGIN { + $VERSION = '1.216_01'; +} + + + + + +##################################################################### +# 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; diff --git a/t/lib/PPI.pm b/t/lib/PPI/Test/Run.pm old mode 100755 new mode 100644 similarity index 55% rename from t/lib/PPI.pm rename to t/lib/PPI/Test/Run.pm index 4cd79acc..29959356 --- a/t/lib/PPI.pm +++ b/t/lib/PPI/Test/Run.pm @@ -1,11 +1,12 @@ -package t::lib::PPI; +package PPI::Test::Run; use File::Spec::Functions ':ALL'; use Test::More; +use Params::Util qw{_INSTANCE}; use Test::Object; -use Params::Util qw{_STRING _INSTANCE}; -use List::MoreUtils 'any'; use PPI::Dumper; +use PPI::Document; +use PPI::Test::Object; use vars qw{$VERSION}; BEGIN { @@ -14,183 +15,6 @@ BEGIN { - - -##################################################################### -# 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' ); -} - - - - - ##################################################################### # Process a .code/.dump file pair # plan: 2 + 14 * npairs @@ -325,3 +149,4 @@ sub increment_testdir { } 1; + diff --git a/t/lib/PPI/Test/pragmas.pm b/t/lib/PPI/Test/pragmas.pm new file mode 100644 index 00000000..263cf849 --- /dev/null +++ b/t/lib/PPI/Test/pragmas.pm @@ -0,0 +1,32 @@ +package PPI::Test::pragmas; + +=head1 NAME + +PPI::Test::pragmas -- standard complier/runtime setup for PPI tests + +=cut + +use 5.006; +use strict; +use warnings; +use Test::NoWarnings; + +BEGIN { + $| = 1; + select STDERR; + $| = 1; + select STDOUT; + + no warnings 'once'; + $PPI::XS_DISABLE = 1; + $PPI::Lexer::X_TOKENIZER ||= $ENV{X_TOKENIZER}; +} + +sub import { + warnings->import(); + strict->import(); + Test::NoWarnings->import(); +} + + +1;