Login
43361665696caa6ce39f197409e4ab2bceb9729f
[gknop/Perl-Critic.git] / t / 03_pragmas.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 Test::More (tests => 28);
15 use Perl::Critic::PolicyFactory (-test => 1);
16
17 # common P::C testing tools
18 use Perl::Critic::TestUtils qw(critique);
19
20 #-----------------------------------------------------------------------------
21
22 our $VERSION = '1.093_01';
23
24 #-----------------------------------------------------------------------------
25
26 Perl::Critic::TestUtils::block_perlcriticrc();
27
28 # Configure Critic not to load certain policies.  This
29 # just makes it a little easier to create test cases
30 my $profile = {
31     '-CodeLayout::RequireTidyCode'                               => {},
32     '-Documentation::PodSpelling'                                => {},
33     '-ErrorHandling::RequireCheckingReturnValueOfEval'           => {},
34     '-Miscellanea::RequireRcsKeywords'                           => {},
35     '-ValuesAndExpressions::ProhibitMagicNumbers'                => {},
36 };
37
38 my $code = undef;
39
40 #-----------------------------------------------------------------------------
41
42 $code = <<'END_PERL';
43 package FOO;
44 use strict;
45 use warnings;
46 our $VERSION = 1.0;
47
48 require 'some_library.pl';  ## no critic
49 print $crap if $condition;  ## no critic
50
51 1;
52 END_PERL
53
54 is(
55     critique(
56         \$code,
57         {-profile => $profile, -severity => 1, -theme => 'core'}
58     ),
59     0,
60     'inline no-critic'
61 );
62
63 #-----------------------------------------------------------------------------
64
65 $code = <<'END_PERL';
66 package FOO;
67 use strict;
68 use warnings;
69 our $VERSION = 1.0;
70
71 $foo = $bar;
72
73 ## no critic
74
75 require 'some_library.pl';
76 print $crap if $condition;
77
78 ## use critic
79
80 $baz = $nuts;
81 1;
82 END_PERL
83
84 is(
85     critique(
86         \$code,
87         {-profile => $profile, -severity => 1, -theme => 'core'},
88     ),
89     0,
90     'region no-critic',
91 );
92
93 #-----------------------------------------------------------------------------
94
95 $code = <<'END_PERL';
96 package FOO;
97 use strict;
98 use warnings;
99 our $VERSION = 1.0;
100
101 for my $foo (@list) {
102   ## no critic
103   $long_int = 12345678;
104   $oct_num  = 033;
105 }
106
107 my $noisy = '!';
108
109 1;
110 END_PERL
111
112 is(
113     critique(
114         \$code,
115         {-profile => $profile, -severity => 1, -theme => 'core'},
116     ),
117     1,
118     'scoped no-critic',
119 );
120
121 #-----------------------------------------------------------------------------
122
123 $code = <<'END_PERL';
124 package FOO;
125 use strict;
126 use warnings;
127 our $VERSION = 1.0;
128
129 {
130   ## no critic
131   $long_int = 12345678;
132   $oct_num  = 033;
133 }
134
135 my $noisy = '!';
136
137 1;
138 END_PERL
139
140 is(
141     critique(
142         \$code,
143         {-profile => $profile, -severity => 1, -theme => 'core'},
144     ),
145     1,
146     'scoped no-critic',
147 );
148
149 #-----------------------------------------------------------------------------
150
151 $code = <<'END_PERL';
152 package FOO;
153 use strict;
154 use warnings;
155 our $VERSION = 1.0;
156
157 ## no critic
158 for my $foo (@list) {
159   $long_int = 12345678;
160   $oct_num  = 033;
161 }
162
163 ## use critic
164 my $noisy = '!';
165
166 1;
167 END_PERL
168
169 is(
170     critique(
171         \$code,
172         {-profile => $profile, -severity => 1, -theme => 'core'},
173     ),
174     1,
175     'region no-critic across a scope',
176 );
177
178 #-----------------------------------------------------------------------------
179
180 $code = <<'END_PERL';
181 package FOO;
182 use strict;
183 use warnings;
184 our $VERSION = 1.0;
185
186 for my $foo (@list) {
187   ## no critic
188   $long_int = 12345678;
189   $oct_num  = 033;
190   ## use critic
191 }
192
193 my $noisy = '!';
194 my $empty = '';
195
196 1;
197 END_PERL
198
199 is(
200     critique(
201         \$code,
202         {-profile => $profile, -severity => 1, -theme => 'core'},
203     ),
204     2,
205     'scoped region no-critic',
206 );
207
208 #-----------------------------------------------------------------------------
209
210 $code = <<'END_PERL';
211 package FOO;
212 use strict;
213 use warnings;
214 our $VERSION = 1.0;
215
216 ## no critic
217 for my $foo (@list) {
218   $long_int = 12345678;
219   $oct_num  = 033;
220 }
221
222 my $noisy = '!';
223 my $empty = '';
224
225 #No final '1;'
226 END_PERL
227
228 is(
229     critique(
230         \$code,
231         {-profile => $profile, -severity => 1, -theme => 'core'},
232     ),
233     0,
234     'unterminated no-critic across a scope',
235 );
236
237 #-----------------------------------------------------------------------------
238
239 $code = <<'END_PERL';
240 package FOO;
241 use strict;
242 use warnings;
243 our $VERSION = 1.0;
244
245 $long_int = 12345678;  ## no critic
246 $oct_num  = 033;       ## no critic
247 my $noisy = '!';       ## no critic
248 my $empty = '';        ## no critic
249 my $empty = '';        ## use critic
250
251 1;
252 END_PERL
253
254 is(
255     critique(
256         \$code,
257         {-profile => $profile, -severity => 1, -theme => 'core'},
258     ),
259     1,
260     'inline use-critic',
261 );
262
263 #-----------------------------------------------------------------------------
264
265 $code = <<'END_PERL';
266 package FOO;
267 use strict;
268 use warnings;
269 our $VERSION = 1.0;
270
271 $long_int = 12345678;  ## no critic
272 $oct_num  = 033;       ## no critic
273 my $noisy = '!';       ## no critic
274 my $empty = '';        ## no critic
275
276 $long_int = 12345678;
277 $oct_num  = 033;
278 my $noisy = '!';
279 my $empty = '';
280
281 #No final '1;'
282 END_PERL
283
284 is(
285     critique(
286         \$code,
287         {-profile => $profile, -severity => 1, -theme => 'core'},
288     ),
289     5,
290     'inline no-critic',
291 );
292
293 #-----------------------------------------------------------------------------
294
295 $code = <<'END_PERL';
296 package FOO;
297 use strict;
298 use warnings;
299 our $VERSION = 1.0;
300
301 $long_int = 12345678;  ## no critic
302 $oct_num  = 033;       ## no critic
303 my $noisy = '!';       ## no critic
304 my $empty = '';        ## no critic
305
306 ## no critic
307 $long_int = 12345678;
308 $oct_num  = 033;
309 my $noisy = '!';
310 my $empty = '';
311
312 #No final '1;'
313 END_PERL
314
315 is(
316     critique(
317         \$code,
318         {
319             -profile  => $profile,
320             -severity => 1,
321             -theme    => 'core',
322             -force    => 1,
323         }
324     ),
325     9,
326     'force option',
327 );
328
329 #-----------------------------------------------------------------------------
330
331 $code = <<'END_PERL';
332 package FOO;
333 use strict;
334 use warnings;
335 our $VERSION = 1.0;
336
337 for my $foo (@list) {
338   ## no critic
339   $long_int = 12345678;
340   $oct_num  = 033;
341 }
342
343 my $noisy = '!'; ## no critic
344 my $empty = '';  ## no critic
345
346 1;
347 END_PERL
348
349 is(
350     critique(
351         \$code,
352         {
353             -profile  => $profile,
354             -severity => 1,
355             -theme    => 'core',
356             -force    => 1,
357         }
358     ),
359     4,
360     'force option',
361 );
362
363 #-----------------------------------------------------------------------------
364
365 $code = <<'END_PERL';
366 package FOO;
367 use strict;
368 use warnings;
369 our $VERSION = 1.0;
370
371 for my $foo (@list) {
372   ## no critic
373   $long_int = 12345678;
374   $oct_num  = 033;
375 }
376
377 ## no critic
378 my $noisy = '!';
379 my $empty = '';
380
381 #No final '1;'
382 END_PERL
383
384 is(
385     critique(
386         \$code,
387         {
388             -profile  => $profile,
389             -severity => 1,
390             -theme    => 'core',
391             -force    => 1,
392         }
393     ),
394     5,
395     'force option',
396 );
397
398 #-----------------------------------------------------------------------------
399 # Check that '## no critic' on the top of a block doesn't extend
400 # to all code within the block.  See RT bug #15295
401
402 $code = <<'END_PERL';
403 package FOO;
404 use strict;
405 use warnings;
406 our $VERSION = 1.0;
407
408 for ($i;$i++;$i<$j) { ## no critic
409     my $long_int = 12345678;
410     my $oct_num  = 033;
411 }
412
413 unless ( $condition1
414          && $condition2 ) { ## no critic
415     my $noisy = '!';
416     my $empty = '';
417 }
418
419 1;
420 END_PERL
421
422 is(
423     critique(
424         \$code,
425         {-profile  => $profile, -severity => 1, -theme => 'core'},
426     ),
427     4,
428     'RT bug 15295',
429 );
430
431 #-----------------------------------------------------------------------------
432 # Check that '## no critic' on the top of a block doesn't extend
433 # to all code within the block.  See RT bug #15295
434
435 $code = <<'END_PERL';
436 package FOO;
437 use strict;
438 use warnings;
439 our $VERSION = 1.0;
440
441 for ($i; $i++; $i<$j) { ## no critic
442     my $long_int = 12345678;
443     my $oct_num  = 033;
444 }
445
446 #Between blocks now
447 $Global::Variable = "foo";  #Package var; double-quotes
448
449 unless ( $condition1
450          && $condition2 ) { ## no critic
451     my $noisy = '!';
452     my $empty = '';
453 }
454
455 1;
456 END_PERL
457
458 is(
459     critique(
460         \$code,
461         {-profile  => $profile, -severity => 1, -theme => 'core'}
462     ),
463     6,
464     'RT bug 15295',
465 );
466
467 #-----------------------------------------------------------------------------
468
469 $code = <<'END_PERL';
470 package FOO;
471 use strict;
472 use warnings;
473 our $VERSION = 1.0;
474
475 sub grep {  ## no critic;
476     return $foo;
477 }
478
479 sub grep { return $foo; } ## no critic
480 1;
481 END_PERL
482
483 is(
484     critique(
485         \$code,
486         {-profile  => $profile, -severity => 1, -theme => 'core'},
487     ),
488     0,
489     'no-critic on sub name',
490 );
491
492 #-----------------------------------------------------------------------------
493
494 $code = <<'END_PERL';
495 package FOO;
496 use strict;
497 use warnings;
498 our $VERSION = 1.0;
499
500 sub grep {  ## no critic;
501    return undef; #Should find this!
502 }
503
504 1;
505 END_PERL
506
507 is(
508     critique(
509         \$code,
510         {-profile  => $profile, -severity =>1, -theme => 'core'}
511     ),
512     1,
513     'no-critic on sub name',
514 );
515
516 #-----------------------------------------------------------------------------
517
518 $code = <<'END_PERL';
519 package FOO;
520 use strict;
521 use warnings;
522 our $VERSION = 1.0;
523
524 ## no critic (NoisyQuotes)
525 my $noisy = '!';
526 my $empty = '';
527 eval $string;
528
529 1;
530 END_PERL
531
532 is(
533     critique(
534         \$code,
535         {-profile  => $profile, -severity => 1, -theme => 'core'}
536     ),
537     2,
538     'per-policy no-critic',
539 );
540
541 #-----------------------------------------------------------------------------
542
543 $code = <<'END_PERL';
544 package FOO;
545 use strict;
546 use warnings;
547 our $VERSION = 1.0;
548
549 ## no critic (ValuesAndExpressions)
550 my $noisy = '!';
551 my $empty = '';
552 eval $string;
553
554 1;
555 END_PERL
556
557 is(
558     critique(
559         \$code,
560         {-profile  => $profile, -severity => 1, -theme => 'core'}
561     ),
562     1,
563     'per-policy no-critic',
564 );
565
566 #-----------------------------------------------------------------------------
567
568 $code = <<'END_PERL';
569 package FOO;
570 use strict;
571 use warnings;
572 our $VERSION = 1.0;
573
574 ## no critic (Noisy, Empty)
575 my $noisy = '!';
576 my $empty = '';
577 eval $string;
578
579 1;
580 END_PERL
581
582 is(
583     critique(
584         \$code,
585         {-profile  => $profile, -severity => 1, -theme => 'core'}
586     ),
587     1,
588     'per-policy no-critic',
589 );
590
591 #-----------------------------------------------------------------------------
592
593 $code = <<'END_PERL';
594 package FOO;
595 use strict;
596 use warnings;
597 our $VERSION = 1.0;
598
599 ## no critic (NOISY, EMPTY, EVAL)
600 my $noisy = '!';
601 my $empty = '';
602 eval $string;
603
604 1;
605 END_PERL
606
607 is(
608     critique(
609         \$code,
610         {-profile  => $profile, -severity => 1, -theme => 'core'}
611     ),
612     0,
613     'per-policy no-critic',
614 );
615
616 #-----------------------------------------------------------------------------
617
618 $code = <<'END_PERL';
619 package FOO;
620 use strict;
621 use warnings;
622 our $VERSION = 1.0;
623
624 ## no critic (Noisy, Empty, Eval)
625 my $noisy = '!';
626 my $empty = '';
627 eval $string;
628
629 ## use critic
630 my $noisy = '!';
631 my $empty = '';
632 eval $string;
633
634 1;
635 END_PERL
636
637 is(
638     critique(
639         \$code,
640         {-profile  => $profile, -severity => 1, -theme => 'core'}
641     ),
642     3,
643     'per-policy no-critic',
644 );
645
646 #-----------------------------------------------------------------------------
647
648 $code = <<'END_PERL';
649 package FOO;
650 use strict;
651 use warnings;
652 our $VERSION = 1.0;
653
654 ## no critic (Critic::Policy)
655 my $noisy = '!';
656 my $empty = '';
657 eval $string;
658
659 1;
660 END_PERL
661
662 is(
663     critique(
664         \$code,
665         {-profile  => $profile, -severity => 1, -theme => 'core'}
666     ),
667     0,
668     'per-policy no-critic',
669 );
670
671 #-----------------------------------------------------------------------------
672
673 $code = <<'END_PERL';
674 package FOO;
675 use strict;
676 use warnings;
677 our $VERSION = 1.0;
678
679 ## no critic (Foo::Bar, Baz, Boom)
680 my $noisy = '!';
681 my $empty = '';
682 eval $string;
683
684 1;
685 END_PERL
686
687 is(
688     critique(
689         \$code,
690         {-profile  => $profile, -severity => 1, -theme => 'core'}
691     ),
692     3,
693     'per-policy no-critic',
694 );
695
696 #-----------------------------------------------------------------------------
697
698 $code = <<'END_PERL';
699 package FOO;
700 use strict;
701 use warnings;
702 our $VERSION = 1.0;
703
704 ## no critic (Noisy)
705 my $noisy = '!';     #Should not find this
706 my $empty = '';      #Should find this
707
708 sub foo {
709
710    ## no critic (Empty)
711    my $nosiy = '!';  #Should not find this
712    my $empty = '';   #Should not find this
713    ## use critic;
714
715    return 1;
716 }
717
718 my $nosiy = '!';  #Should not find this
719 my $empty = '';   #Should find this
720
721 1;
722 END_PERL
723
724 is(
725     critique(
726         \$code,
727         {-profile  => $profile, -severity => 1, -theme => 'core'}
728     ),
729     2,
730     'per-policy no-critic',
731 );
732
733 #-----------------------------------------------------------------------------
734 $code = <<'END_PERL';
735 package FOO;
736
737 use strict;
738 use warnings;
739 our $VERSION = 1.0;
740
741 # with parentheses
742 my $noisy = '!';           ##no critic (NoisyQuotes)
743 barf() unless $$ eq '';    ##no critic (Postfix,Empty,Punctuation)
744 barf() unless $$ eq '';    ##no critic (Postfix , Empty , Punctuation)
745 barf() unless $$ eq '';    ##no critic (Postfix Empty Punctuation)
746
747 # qw() style
748 my $noisy = '!';           ##no critic qw(NoisyQuotes);
749 barf() unless $$ eq '';    ##no critic qw(Postfix,Empty,Punctuation)
750 barf() unless $$ eq '';    ##no critic qw(Postfix , Empty , Punctuation)
751 barf() unless $$ eq '';    ##no critic qw(Postfix Empty Punctuation)
752
753 # no parentheses
754 my $noisy = '!';           ##no critic NoisyQuotes;
755 barf() unless $$ eq '';    ##no critic Postfix,Empty,Punctuation;
756 barf() unless $$ eq '';    ##no critic Postfix , Empty , Punctuation;
757 barf() unless $$ eq '';    ##no critic Postfix Empty Punctuation;
758
759 1;
760 END_PERL
761
762 is(
763     critique(
764         \$code,
765         {-profile => $profile, -severity => 1, -theme => 'core'},
766     ),
767     0,
768     'no critic: syntaxes',
769 );
770
771 #-----------------------------------------------------------------------------
772 # Most policies apply to a particular type of PPI::Element and usually
773 # only return one Violation at a time.  But the next three cases
774 # involve policies that apply to the whole document and can return
775 # multiple violations at a time.  These tests make sure that the 'no
776 # critic' pragmas are effective with those Policies
777 #-----------------------------------------------------------------------------
778
779 $code = <<'END_PERL';
780 package FOO;
781
782 #Code before 'use strict'
783 my $foo = 'baz';  ## no critic
784 my $bar = 42;     # Should find this
785
786 use strict;
787 use warnings;
788 our $VERSION = 1.0;
789
790 1;
791 END_PERL
792
793 is(
794     critique(
795         \$code,
796         {-profile  => $profile, -severity => 5, -theme => 'core'},
797     ),
798     1,
799     'no critic & RequireUseStrict',
800 );
801
802 #-----------------------------------------------------------------------------
803
804 $code = <<'END_PERL';
805 package FOO;
806 use strict;
807
808 #Code before 'use warnings'
809 my $foo = 'baz';  ## no critic
810 my $bar = 42;  # Should find this
811
812 use warnings;
813 our $VERSION = 1.0;
814
815 1;
816 END_PERL
817
818 is(
819     critique(
820         \$code,
821         {-profile  => $profile, -severity => 4, -theme => 'core'},
822     ),
823     1,
824     'no critic & RequireUseWarnings',
825 );
826
827 #-----------------------------------------------------------------------------
828
829 $code = <<'END_PERL';
830 use strict;      ##no critic
831 use warnings;    #should find this
832 my $bar = 42;    #this one will be squelched
833
834 package FOO;
835
836 our $VERSION = 1.0;
837
838 1;
839 END_PERL
840
841 is(
842     critique(
843         \$code,
844         {-profile  => $profile, -severity => 4, -theme => 'core'},
845     ),
846     1,
847     'no critic & RequireExplicitPackage',
848 );
849
850 #-----------------------------------------------------------------------------
851
852 # ensure we run true if this test is loaded by
853 # t/03_pragmas.t_without_optional_dependencies.t
854 1;
855
856 ##############################################################################
857 # Local Variables:
858 #   mode: cperl
859 #   cperl-indent-level: 4
860 #   fill-column: 78
861 #   indent-tabs-mode: nil
862 #   c-indentation-style: bsd
863 # End:
864 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :