← Back to branch summary

~ubuntu-branches/ubuntu/saucy/padre/saucy-proposed

« back to all changes in this revision

Viewing changes to t/perl/general.t

  • Committer: Package Import Robot
  • Author(s): Dominique Dumont, gregor herrmann, Dominique Dumont
  • Date: 2012-01-04 12:04:20 UTC
  • mfrom: (1.3.3)
  • Revision ID: package-import@ubuntu.com-20120104120420-i5oybqwf91m1d3il
Tags: 0.92.ds1-1
[ gregor herrmann ]
* Remove debian/source/local-options; abort-on-upstream-changes
  and unapply-patches are default in dpkg-source since 1.16.1.
* Swap order of alternative (build) dependencies after the perl
  5.14 transition.

[ Dominique Dumont ]
* Imported Upstream version 0.92.ds1
* removed fix-spelling patch (applied upstream)
* lintian-override: use wildcard to avoid listing a gazillion files
* updated size of some 'not-real-man-page' entries
* rules: remove dekstop cruft (replaced by a file provided in debian
  directory)
* control: removed Breaks statement. Add /me to uploaders. Updated
  dependencies
* rules: make sure that non-DFSG file (i.e. the cute butterfly, sigh)
  is not distributed

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/perl/general.t
 
1
#!/usr/bin/perl
 
2
 
 
3
use strict;
 
4
use warnings;
 
5
use Test::More;
 
6
 
 
7
BEGIN {
 
8
        unless ( $ENV{DISPLAY} or $^O eq 'MSWin32' ) {
 
9
                plan skip_all => 'Needs DISPLAY';
 
10
                exit 0;
 
11
        }
 
12
        plan( tests => 40 );
 
13
}
 
14
use Test::NoWarnings;
 
15
use File::Spec::Functions ':ALL';
 
16
 
 
17
# Padre can move the cwd around, so save in the location of the
 
18
# test files early before that happens
 
19
my $files = rel2abs( catdir( 't', 'files' ) );
 
20
 
 
21
use t::lib::Padre;
 
22
use t::lib::Padre::Editor;
 
23
 
 
24
use Padre;
 
25
use Padre::Document;
 
26
use Padre::PPI;
 
27
use PPI::Document;
 
28
 
 
29
# Create the object so that ide works
 
30
my $app = Padre->new;
 
31
isa_ok( $app, 'Padre' );
 
32
 
 
33
SCOPE: {
 
34
        my $editor = t::lib::Padre::Editor->new;
 
35
        my $file   = catfile( $files, 'missing_brace_1.pl' );
 
36
        my $doc    = Padre::Document->new(
 
37
                filename => $file,
 
38
        );
 
39
        $doc->set_editor($editor);
 
40
        $editor->set_document($doc);
 
41
 
 
42
        sub is_row_ok {
 
43
                my %arg = @_;
 
44
                my $row = $arg{row};
 
45
                like( $row->{message}, $arg{message}, "message regex match in '$arg{test_name}'" );
 
46
                is( $row->{line}, $arg{line}, "line match in '$arg{test_name}'" );
 
47
                is( $row->{type}, $arg{type}, "type match in '$arg{test_name}'" );
 
48
        }
 
49
 
 
50
        isa_ok( $doc, 'Padre::Document' );
 
51
        isa_ok( $doc, 'Padre::Document::Perl' );
 
52
        is( $doc->filename, $file, 'filename' );
 
53
}
 
54
 
 
55
# first block of tests for Padre::PPI::find_variable_declaration
 
56
# and ...find_token_at_location
 
57
SCOPE: {
 
58
        my $infile = catfile( $files, 'find_variable_declaration_1.pm' );
 
59
        my $text = do {
 
60
                local $/ = undef;
 
61
                open my $fh, '<', $infile or die $!;
 
62
                my $rv = <$fh>;
 
63
                close $fh;
 
64
                $rv;
 
65
        };
 
66
        my $doc = PPI::Document->new( \$text );
 
67
        isa_ok( $doc, "PPI::Document" );
 
68
        $doc->index_locations;
 
69
 
 
70
        my $elem = find_var_simple( $doc, '$n_threads_to_kill', 137 );
 
71
        isa_ok( $elem, 'PPI::Token::Symbol' );
 
72
 
 
73
        $doc->flush_locations(); # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
74
                                 #my $doc2 = PPI::Document->new( \$text );
 
75
        my $cmp_elem = Padre::PPI::find_token_at_location( $doc, [ 137, 26, 26 ] );
 
76
        ok( $elem == $cmp_elem, 'find_token_at_location returns the same token as a manual search' );
 
77
        my $declaration;
 
78
        $doc->find_first(
 
79
                sub {
 
80
                        return 0
 
81
                                if not $_[1]->isa('PPI::Statement::Variable')
 
82
                                        or not $_[1]->location->[0] == 131;
 
83
                        $declaration = $_[1];
 
84
                        return 1;
 
85
                }
 
86
        );
 
87
        isa_ok( $declaration, 'PPI::Statement::Variable' );
 
88
 
 
89
        $doc->flush_locations(); # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
90
        my $cmp_declaration = Padre::PPI::find_token_at_location( $doc, [ 131, 2, 9 ] );
 
91
 
 
92
        # They're not really the same. The manual search finds the entire Statement node. Hence the first_element.
 
93
        ok( $declaration->first_element() == $cmp_declaration,
 
94
                'find_token_at_location returns the same token as a manual search'
 
95
        );
 
96
 
 
97
        my $result_declaration = Padre::PPI::find_variable_declaration($elem);
 
98
 
 
99
        ok( $declaration == $result_declaration, 'Correct declaration found' );
 
100
}
 
101
 
 
102
# second block of tests for Padre::PPI::find_variable_declaration
 
103
# and ...find_token_at_location
 
104
SCOPE: {
 
105
        my $infile = catfile( $files, 'find_variable_declaration_2.pm' );
 
106
        my $text = do {
 
107
                local $/ = undef;
 
108
                open my $fh, '<', $infile or die $!;
 
109
                my $rv = <$fh>;
 
110
                close $fh;
 
111
                $rv;
 
112
        };
 
113
 
 
114
        my $doc = PPI::Document->new( \$text );
 
115
        isa_ok( $doc, "PPI::Document" );
 
116
        $doc->index_locations;
 
117
 
 
118
        # Test foreach my $i
 
119
        my $elem = find_var_simple( $doc, '$i', 8 ); # search $i in line 8
 
120
        isa_ok( $elem, 'PPI::Token::Symbol' );
 
121
 
 
122
        $doc->flush_locations(); # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
123
        my $cmp_elem = Padre::PPI::find_token_at_location( $doc, [ 8, 5, 5 ] );
 
124
        ok( $elem == $cmp_elem, 'find_token_at_location returns the same token as a manual search' );
 
125
 
 
126
        $doc->flush_locations(); # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
127
        my $declaration = Padre::PPI::find_token_at_location( $doc, [ 7, 14, 14 ] );
 
128
        isa_ok( $declaration, 'PPI::Token::Symbol' );
 
129
        my $prev_sibling = $declaration->sprevious_sibling();
 
130
        ok( (           defined($prev_sibling)
 
131
                                and $prev_sibling->isa('PPI::Token::Word')
 
132
                                and $prev_sibling->content() =~ /^(?:my|our)$/
 
133
                ),
 
134
                "Find variable declaration in foreach"
 
135
        );
 
136
 
 
137
        $doc->flush_locations(); # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
138
        my $result_declaration = Padre::PPI::find_variable_declaration($elem);
 
139
        ok( $declaration == $result_declaration, 'Correct declaration found' );
 
140
 
 
141
        # Now the same for "for our $k"
 
142
        $elem = find_var_simple( $doc, '$k', 11 ); # search $k in line 11
 
143
        isa_ok( $elem, 'PPI::Token::Symbol' );
 
144
 
 
145
        # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
146
        $doc->flush_locations();
 
147
        $cmp_elem = Padre::PPI::find_token_at_location( $doc, [ 11, 5, 5 ] );
 
148
        ok( $elem == $cmp_elem, 'find_token_at_location returns the same token as a manual search' );
 
149
 
 
150
        # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
151
        $doc->flush_locations();
 
152
        $declaration = Padre::PPI::find_token_at_location( $doc, [ 10, 11, 11 ] );
 
153
        isa_ok( $declaration, 'PPI::Token::Symbol' );
 
154
        $prev_sibling = $declaration->sprevious_sibling();
 
155
        ok( (           defined($prev_sibling)
 
156
                                and $prev_sibling->isa('PPI::Token::Word')
 
157
                                and $prev_sibling->content() =~ /^(?:my|our)$/
 
158
                ),
 
159
                "Find variable declaration in foreach"
 
160
        );
 
161
 
 
162
        # TODO: This shouldn't have to be here. But remove it and things break -- Adam?
 
163
        $doc->flush_locations();
 
164
        SKIP: {
 
165
                skip( "PPI parses 'for our \$foo (...){}' badly", 1 );
 
166
                $result_declaration = Padre::PPI::find_variable_declaration($elem);
 
167
                ok( $declaration == $result_declaration, 'Correct declaration found' );
 
168
        }
 
169
}
 
170
 
 
171
# Regression test for functions
 
172
SCOPE: {
 
173
        my $editor = t::lib::Padre::Editor->new;
 
174
        my $file   = catfile( $files, 'perl_functions.pl' );
 
175
        my $doc    = Padre::Document->new(
 
176
                filename => $file,
 
177
        );
 
178
        $doc->set_editor($editor);
 
179
        $editor->set_document($doc);
 
180
 
 
181
        my @functions = $doc->functions;
 
182
        is_deeply(
 
183
                \@functions,
 
184
                [   qw{
 
185
                                guess_indentation_style
 
186
                                guess_filename
 
187
                                get_calltip_keywords
 
188
                                two_lines
 
189
                                three_lines
 
190
                                after_data
 
191
                                }
 
192
                ],
 
193
                'Found expected Perl functions',
 
194
        );
 
195
}
 
196
 
 
197
# Regression test for functions on Method::Signatures-style method declarators
 
198
SCOPE: {
 
199
        my @test_files = (
 
200
                {   'filename' => 'method_declarator_1.pm',
 
201
                        'methods'  => [
 
202
                                qw/
 
203
                                        _build__ca_state_holidays
 
204
                                        is_holiday_or_weekend
 
205
                                        /
 
206
                        ],
 
207
                },
 
208
                {   'filename' => 'method_declarator_2.pm',
 
209
                        'methods'  => [
 
210
                                qw/
 
211
                                        new
 
212
                                        iso_date
 
213
                                        /
 
214
                        ],
 
215
                },
 
216
                {   'filename' => 'method_declarator_3.pm',
 
217
                        'methods'  => [
 
218
                                qw/
 
219
                                        strip_ws
 
220
                                        /
 
221
                        ],
 
222
                },
 
223
        );
 
224
 
 
225
        foreach my $test_file (@test_files) {
 
226
                my $editor = t::lib::Padre::Editor->new;
 
227
                my $file   = catfile( $files, $test_file->{'filename'} );
 
228
                my $doc    = Padre::Document->new(
 
229
                        filename => $file,
 
230
                );
 
231
                $doc->set_editor($editor);
 
232
                $editor->set_document($doc);
 
233
 
 
234
                my @functions = $doc->functions;
 
235
                is_deeply(
 
236
                        \@functions,
 
237
                        $test_file->{'methods'},
 
238
                        'Found expected declarator-declared Perl functions',
 
239
                );
 
240
        }
 
241
}
 
242
 
 
243
# Tests for content intuition
 
244
SCOPE: {
 
245
        my $editor = t::lib::Padre::Editor->new;
 
246
        my $doc    = Padre::Document::Perl->new;
 
247
        $doc->set_editor($editor);
 
248
        $editor->set_document($doc);
 
249
        $doc->text_set(<<'END_PERL');
 
250
package Foo::Bar::Baz;
 
251
 
 
252
1;
 
253
END_PERL
 
254
 
 
255
        # Check the filename
 
256
        my $filename = $doc->guess_filename;
 
257
        is( $filename, 'Baz.pm', '->guess_filename ok' );
 
258
 
 
259
        # Check the subpath
 
260
        my @subpath = $doc->guess_subpath;
 
261
        is_deeply( \@subpath, [qw{ lib Foo Bar }], '->guess_subpath' );
 
262
}
 
263
 
 
264
# Test POD endification
 
265
SCOPE: {
 
266
        use_ok('Padre::PPI::EndifyPod');
 
267
        my $merge = Padre::PPI::EndifyPod->new;
 
268
        isa_ok( $merge, 'Padre::PPI::EndifyPod' );
 
269
        my $document = PPI::Document->new( \<<'END_PERL' );
 
270
package Foo;
 
271
 
 
272
=pod
 
273
 
 
274
This is POD
 
275
 
 
276
=cut
 
277
 
 
278
use strict;
 
279
 
 
280
=pod
 
281
 
 
282
This is also POD
 
283
 
 
284
=cut
 
285
 
 
286
1;
 
287
END_PERL
 
288
        isa_ok( $document, 'PPI::Document' );
 
289
        ok( $merge->apply($document), 'Transform applied ok' );
 
290
        is( $document->serialize, <<'END_PERL', 'Transformed ok' );
 
291
package Foo;
 
292
 
 
293
 
 
294
use strict;
 
295
 
 
296
 
 
297
1;
 
298
 
 
299
__END__
 
300
 
 
301
=pod
 
302
 
 
303
This is POD
 
304
 
 
305
This is also POD
 
306
 
 
307
=cut
 
308
END_PERL
 
309
}
 
310
 
 
311
# Test copyright updating
 
312
SCOPE: {
 
313
        use_ok('Padre::PPI::UpdateCopyright');
 
314
        my $copyright = Padre::PPI::UpdateCopyright->new(
 
315
                name => 'Adam Kennedy',
 
316
        );
 
317
        isa_ok( $copyright, 'Padre::PPI::UpdateCopyright' );
 
318
        my $document = PPI::Document->new( \<<'END_PERL' );
 
319
package Foo;
 
320
 
 
321
=pod
 
322
 
 
323
Copyright 2008 - 2009 Adam Kennedy.
 
324
 
 
325
=cut
 
326
 
 
327
1;
 
328
END_PERL
 
329
        isa_ok( $document, 'PPI::Document' );
 
330
        ok( $copyright->apply($document), 'Transform applied ok' );
 
331
        my $serialized = $document->serialize;
 
332
        ok( $serialized =~ /2008 - (\d\d\d\d)/, 'Found copyright statement' );
 
333
        ok( $1 ne '2009', 'Copyright year has changed' );
 
334
        ok( $1 > 2009, 'Copyright year is newer' );
 
335
}
 
336
 
 
337
 
 
338
 
 
339
 
 
340
 
 
341
######################################################################
 
342
# Support Functions
 
343
 
 
344
sub find_var_simple {
 
345
        my $doc     = shift;
 
346
        my $varname = shift;
 
347
        my $line    = shift;
 
348
 
 
349
        my $elem;
 
350
        $doc->find_first(
 
351
                sub {
 
352
                        return 0
 
353
                                if not $_[1]->isa('PPI::Token::Symbol')
 
354
                                        or not $_[1]->content eq $varname
 
355
                                        or not $_[1]->location->[0] == $line;
 
356
                        $elem = $_[1];
 
357
                        return 1;
 
358
                }
 
359
        );
 
360
        return $elem;
 
361
}