git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/03_pragmas.t

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