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 :