git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/08_document.t

   1 #!perl
   2
   3 ##############################################################################
   4 #     $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/08_document.t $
   5 #    $Date: 2008-06-06 00:48:04 -0500 (Fri, 06 Jun 2008) $
   6 #   $Author: clonezone $
   7 # $Revision: 2416 $
   8 ##############################################################################
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use version;
  15
  16 use Perl::Critic::Utils::DataConversion qw< dor >;
  17
  18 use Test::More tests => 25;
  19
  20 #-----------------------------------------------------------------------------
  21
  22 use_ok('Perl::Critic::Document');
  23 can_ok('Perl::Critic::Document', 'new');
  24 can_ok('Perl::Critic::Document', 'filename');
  25 can_ok('Perl::Critic::Document', 'find');
  26 can_ok('Perl::Critic::Document', 'find_first');
  27 can_ok('Perl::Critic::Document', 'find_any');
  28 can_ok('Perl::Critic::Document', 'highest_explicit_perl_version');
  29 can_ok('Perl::Critic::Document', 'ppi_document');
  30
  31 {
  32     my $code = q{'print 'Hello World';};  #Has 6 PPI::Element
  33     my $ppi_doc = PPI::Document->new( \$code );
  34     my $pc_doc  = Perl::Critic::Document->new( $ppi_doc );
  35     isa_ok($pc_doc, 'Perl::Critic::Document');
  36
  37
  38     my $nodes_ref = $pc_doc->find('PPI::Element');
  39     is( scalar @{ $nodes_ref }, 6, 'find by class name');
  40
  41     $nodes_ref = $pc_doc->find( sub{ return 1 } );
  42     is( scalar @{ $nodes_ref }, 6, 'find by wanted() handler');
  43
  44     $nodes_ref = $pc_doc->find( q{Element} );
  45     is( scalar @{ $nodes_ref }, 6, 'find by shortened class name');
  46
  47     #---------------------------
  48
  49     my $node = $pc_doc->find_first('PPI::Element');
  50     is( ref $node, 'PPI::Statement', 'find_first by class name');
  51
  52     $node = $pc_doc->find_first( sub{ return 1 } );
  53     is( ref $node, 'PPI::Statement', 'find_first by wanted() handler');
  54
  55     $node = $pc_doc->find_first( q{Element} );
  56     is( ref $node, 'PPI::Statement', 'find_first by shortened class name');
  57
  58     #---------------------------
  59
  60     my $found = $pc_doc->find_any('PPI::Element');
  61     is( $found, 1, 'find_any by class name');
  62
  63     $found = $pc_doc->find_any( sub{ return 1 } );
  64     is( $found, 1, 'find_any by wanted() handler');
  65
  66     $found = $pc_doc->find_any( q{Element} );
  67     is( $found, 1, 'find_any by shortened class name');
  68
  69     #-------------------------------------------------------------------------
  70
  71     {
  72         # Ignore "Cannot create search condition for 'PPI::': Not a PPI::Element"
  73         local $SIG{__WARN__} = sub {
  74             $_[0] =~ m/\QCannot create search condition for\E/ || warn @_
  75         };
  76         $nodes_ref = $pc_doc->find( q{} );
  77         is( $nodes_ref, undef, 'find by empty class name');
  78
  79         $node = $pc_doc->find_first( q{} );
  80         is( $node, undef, 'find_first by empty class name');
  81
  82         $found = $pc_doc->find_any( q{} );
  83         is( $found, undef, 'find_any by empty class name');
  84
  85     }
  86 }
  87
  88 #-----------------------------------------------------------------------------
  89
  90 {
  91     test_version( 'sub { 1 }', undef );
  92     test_version( 'use 5.006', version->new('5.006') );
  93     test_version( 'use 5.8.3', version->new('5.8.3') );
  94     test_version(
  95         'use 5.006; use 5.8.3; use 5.005005',
  96         version->new('5.8.3'),
  97     );
  98 }
  99
 100 sub test_version {
 101     my ($code, $expected_version) = @_;
 102
 103     my $description_version = dor( $expected_version, '<undef>' );
 104
 105     my $document =
 106         Perl::Critic::Document->new(
 107             PPI::Document->new( \$code )
 108         );
 109
 110     is(
 111         $document->highest_explicit_perl_version(),
 112         $expected_version,
 113         qq<Get "$description_version" for "$code".>,
 114     );
 115 }
 116
 117 #-----------------------------------------------------------------------------
 118
 119 # ensure we run true if this test is loaded by
 120 # t/08_document.t_without_optional_dependencies.t
 121 1;
 122
 123 # Local Variables:
 124 #   mode: cperl
 125 #   cperl-indent-level: 4
 126 #   fill-column: 78
 127 #   indent-tabs-mode: nil
 128 #   c-indentation-style: bsd
 129 # End:
 130 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :