The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ELLIOTJS / Perl-Critic-1.083_002 / t / 08_document.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129

              
#!perl
##############################################################################
#     $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/08_document.t $
#    $Date: 2008-04-06 21:30:51 -0500 (Sun, 06 Apr 2008) $
#   $Author: clonezone $
# $Revision: 2208 $
##############################################################################
use strict;
use warnings;
use version;
use Perl::Critic::Utils::DataConversion qw< dor >;
use Test::More tests => 25;
#-----------------------------------------------------------------------------
use_ok('Perl::Critic::Document');
can_ok('Perl::Critic::Document', 'new');
can_ok('Perl::Critic::Document', 'filename');
can_ok('Perl::Critic::Document', 'find');
can_ok('Perl::Critic::Document', 'find_first');
can_ok('Perl::Critic::Document', 'find_any');
can_ok('Perl::Critic::Document', 'highest_explicit_perl_version');
can_ok('Perl::Critic::Document', 'ppi_document');
{
    my $code = q{'print 'Hello World';};  #Has 6 PPI::Element
    my $ppi_doc = PPI::Document->new( \$code );
    my $pc_doc  = Perl::Critic::Document->new( $ppi_doc );
    isa_ok($pc_doc, 'Perl::Critic::Document');
    my $nodes_ref = $pc_doc->find('PPI::Element');
    is( scalar @{ $nodes_ref }, 6, 'find by class name');
    $nodes_ref = $pc_doc->find( sub{ return 1 } );
    is( scalar @{ $nodes_ref }, 6, 'find by wanted() handler');
    $nodes_ref = $pc_doc->find( q{Element} );
    is( scalar @{ $nodes_ref }, 6, 'find by shortened class name');
    #---------------------------
    my $node = $pc_doc->find_first('PPI::Element');
    is( ref $node, 'PPI::Statement', 'find_first by class name');
    $node = $pc_doc->find_first( sub{ return 1 } );
    is( ref $node, 'PPI::Statement', 'find_first by wanted() handler');
    $node = $pc_doc->find_first( q{Element} );
    is( ref $node, 'PPI::Statement', 'find_first by shortened class name');
    #---------------------------
    my $found = $pc_doc->find_any('PPI::Element');
    is( $found, 1, 'find_any by class name');
    $found = $pc_doc->find_any( sub{ return 1 } );
    is( $found, 1, 'find_any by wanted() handler');
    $found = $pc_doc->find_any( q{Element} );
    is( $found, 1, 'find_any by shortened class name');
    #-------------------------------------------------------------------------
    {
        # Ignore "Cannot create search condition for 'PPI::': Not a PPI::Element"
        local $SIG{__WARN__} = sub {
            $_[0] =~ m/\QCannot create search condition for\E/ || warn @_
        };
        $nodes_ref = $pc_doc->find( q{} );
        is( $nodes_ref, undef, 'find by empty class name');
        $node = $pc_doc->find_first( q{} );
        is( $node, undef, 'find_first by empty class name');
        $found = $pc_doc->find_any( q{} );
        is( $found, undef, 'find_any by empty class name');
    }
}
#-----------------------------------------------------------------------------
{
    test_version( 'sub { 1 }', undef );
    test_version( 'use 5.006', version->new('5.006') );
    test_version( 'use 5.8.3', version->new('5.8.3') );
    test_version(
        'use 5.006; use 5.8.3; use 5.005005',
        version->new('5.8.3'),
    );
}
sub test_version {
    my ($code, $expected_version) = @_;
    my $description_version = dor( $expected_version, '<undef>' );
    my $document =
        Perl::Critic::Document->new(
            PPI::Document->new( \$code )
        );
    is(
        $document->highest_explicit_perl_version(),
        $expected_version,
        qq<Get "$description_version" for "$code".>,
    );
}
#-----------------------------------------------------------------------------
# ensure we run true if this test is loaded by
# t/08_document.t_without_optional_dependencies.t
1;
# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :