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