Login
c84a5af68a8eff3824ab737363602ec08b11f067
[gknop/Perl-Critic.git] / t / 08_document.t
1 #!perl
2
3 ##############################################################################
4 #     $URL$
5 #    $Date$
6 #   $Author$
7 # $Revision$
8 ##############################################################################
9
10 use 5.006001;
11 use strict;
12 use warnings;
13
14 use Carp qw< carp >;
15
16 use version;
17
18
19 use Perl::Critic::Document qw< >;
20 use Perl::Critic::Utils qw< $EMPTY >;
21 use Perl::Critic::Utils::DataConversion qw< dor >;
22
23
24 use Test::Deep;
25 use Test::More tests => 41;
26
27 #-----------------------------------------------------------------------------
28
29 our $VERSION = '1.110';
30
31 #-----------------------------------------------------------------------------
32
33 can_ok('Perl::Critic::Document', 'new');
34 can_ok('Perl::Critic::Document', 'filename');
35 can_ok('Perl::Critic::Document', 'find');
36 can_ok('Perl::Critic::Document', 'find_first');
37 can_ok('Perl::Critic::Document', 'find_any');
38 can_ok('Perl::Critic::Document', 'namespaces');
39 can_ok('Perl::Critic::Document', 'subdocuments_for_namespace');
40 can_ok('Perl::Critic::Document', 'highest_explicit_perl_version');
41 can_ok('Perl::Critic::Document', 'uses_module');
42 can_ok('Perl::Critic::Document', 'ppi_document');
43 can_ok('Perl::Critic::Document', 'is_program');
44 can_ok('Perl::Critic::Document', 'is_module');
45
46 {
47     my $code = q{'print 'Hello World';};  #Has 6 PPI::Element
48     my $ppi_doc = PPI::Document->new( \$code );
49     my $pc_doc  = Perl::Critic::Document->new( '-source' => $ppi_doc );
50     isa_ok($pc_doc, 'Perl::Critic::Document');
51     isa_ok($pc_doc, 'PPI::Document');
52     isa_ok($pc_doc, 'PPI::Node');
53     isa_ok($pc_doc, 'PPI::Element');
54
55
56     my $nodes_ref = $pc_doc->find('PPI::Element');
57     is( scalar @{ $nodes_ref }, 6, 'find by class name');
58
59     $nodes_ref = $pc_doc->find( sub{ return 1 } );
60     is( scalar @{ $nodes_ref }, 6, 'find by wanted() handler');
61
62     $nodes_ref = $pc_doc->find( q{Element} );
63     is( scalar @{ $nodes_ref }, 6, 'find by shortened class name');
64
65     #---------------------------
66
67     my $node = $pc_doc->find_first('PPI::Element');
68     is( ref $node, 'PPI::Statement', 'find_first by class name');
69
70     $node = $pc_doc->find_first( sub{ return 1 } );
71     is( ref $node, 'PPI::Statement', 'find_first by wanted() handler');
72
73     $node = $pc_doc->find_first( q{Element} );
74     is( ref $node, 'PPI::Statement', 'find_first by shortened class name');
75
76     #---------------------------
77
78     my $found = $pc_doc->find_any('PPI::Element');
79     is( $found, 1, 'find_any by class name');
80
81     $found = $pc_doc->find_any( sub{ return 1 } );
82     is( $found, 1, 'find_any by wanted() handler');
83
84     $found = $pc_doc->find_any( q{Element} );
85     is( $found, 1, 'find_any by shortened class name');
86
87     #-------------------------------------------------------------------------
88
89     {
90         # Ignore "Cannot create search condition for 'PPI::': Not a PPI::Element"
91         local $SIG{__WARN__} = sub {
92             $_[0] =~ m/\QCannot create search condition for\E/xms || carp @_
93         };
94         $nodes_ref = $pc_doc->find( q{} );
95         is( $nodes_ref, undef, 'find by empty class name');
96
97         $node = $pc_doc->find_first( q{} );
98         is( $node, undef, 'find_first by empty class name');
99
100         $found = $pc_doc->find_any( q{} );
101         is( $found, undef, 'find_any by empty class name');
102
103     }
104
105     #-------------------------------------------------------------------------
106
107     cmp_deeply(
108         [ $pc_doc->namespaces() ],
109         ['main'],
110         q<everything is in the "main" namespace>,
111     );
112
113     ok( $pc_doc->is_module(), q{document type 'module' is a module});
114     ok( ! $pc_doc->is_program(), q{document type 'module' is not a program});
115
116 }
117
118 #-----------------------------------------------------------------------------
119
120 {
121     my $ppi_document = PPI::Document->new(\'foo(); package Foo; package Bar');
122     my $critic_document =
123         Perl::Critic::Document->new(-source => $ppi_document);
124
125     cmp_deeply(
126         [ $critic_document->namespaces() ],
127         bag( qw< main Foo Bar > ),
128         'Got expected namespaces',
129     );
130 }
131
132 #-----------------------------------------------------------------------------
133
134 {
135     my $ppi_document = PPI::Document->new(\'use Moose');
136     my $critic_document =
137         Perl::Critic::Document->new(-source => $ppi_document);
138
139     ok(!! $critic_document->uses_module('Moose'),       'Moose is used.');
140     ok( ! $critic_document->uses_module('Moose::Role'), 'Moose::Role is not used.');
141
142     $ppi_document = PPI::Document->new( \q{ } );
143     $critic_document =
144         Perl::Critic::Document->new(-source => $ppi_document);
145
146     ok(
147         ! $critic_document->uses_module('Blah'),
148         q<uses_module() doesn't barf when there are no include statements.>,
149     );
150 }
151
152 #-----------------------------------------------------------------------------
153
154
155 {
156     test_version( 'sub { 1 }', undef );
157     test_version( 'use 5.006', version->new('5.006') );
158     test_version( 'use 5.8.3', version->new('5.8.3') );
159     test_version(
160         'use 5.006; use 5.8.3; use 5.005005',
161         version->new('5.8.3'),
162     );
163     test_version( 'use 5.005_05; use 5.005_03', version->new('5.005_05') );
164     test_version( 'use 5.005_03; use 5.005_05', version->new('5.005_05') );
165 }
166
167 sub test_version {
168     my ($code, $expected_version) = @_;
169
170     my $description_version = dor( $expected_version, '<undef>' );
171
172     my $document =
173         Perl::Critic::Document->new(
174             '-source' => PPI::Document->new( \$code )
175         );
176
177     is(
178         $document->highest_explicit_perl_version(),
179         $expected_version,
180         qq<Get "$description_version" for "$code".>,
181     );
182
183     return;
184 }
185
186 #-----------------------------------------------------------------------------
187
188 # ensure we return true if this test is loaded by
189 # t/08_document.t_without_optional_dependencies.t
190 1;
191
192 # Local Variables:
193 #   mode: cperl
194 #   cperl-indent-level: 4
195 #   fill-column: 78
196 #   indent-tabs-mode: nil
197 #   c-indentation-style: bsd
198 # End:
199 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :