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::ProhibitUnrestrictedNoCritic'                 => {},
  35     '-Miscellanea::RequireRcsKeywords'                           => {},
  36     '-ValuesAndExpressions::ProhibitMagicNumbers'                => {},
  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 :