1#!/perl -w 2use strict; 3 4# See "Writing a test" in perlhack.pod for the instructions about the order that 5# testing directories run, and which constructions should be avoided in the 6# early tests. 7 8# This regression tests ensures that the rules aren't accidentally overlooked. 9 10BEGIN { 11 chdir 't'; 12 require './test.pl'; 13} 14 15plan('no_plan'); 16 17open my $fh, '<', '../MANIFEST' or die "Can't open MANIFEST: $!"; 18 19# Some tests in t/comp need to use require or use to get their job done: 20my %exceptions = ( 21 filter_exception => "require './test.pl'", 22 hints => "require './test.pl'", 23 parser => 'use DieDieDie', 24 parser_run => "require './test.pl'", 25 proto => 'use strict', 26 ); 27 28while (my $file = <$fh>) { 29 next unless $file =~ s!^t/!!; 30 chomp $file; 31 $file =~ s/\s+.*//; 32 next unless $file =~ m!\.t$!; 33 34 local $/; 35 open my $t, '<', $file or die "Can't open $file: $!"; 36 # avoid PERL_UNICODE causing us to read non-UTF-8 files as UTF-8 37 binmode $t; 38 my $contents = <$t>; 39 # Make sure that we don't match ourselves 40 unlike($contents, qr/use\s+Test::More/, "$file doesn't use Test::\QMore"); 41 next unless $file =~ m!^base/! or $file =~ m!^comp!; 42 43 # Remove only the excepted constructions for the specific files. 44 if ($file =~ m!comp/(.*)\.t! && $exceptions{$1}) { 45 my $allowed = $exceptions{$1}; 46 $contents =~ s/\Q$allowed//gs; 47 } 48 49 # All uses of use are allowed in t/comp/use.t 50 unlike($contents, qr/^\s*use\s+/m, "$file doesn't use use") 51 unless $file eq 'comp/use.t'; 52 # All uses of require are allowed in t/comp/require.t 53 unlike($contents, qr/^\s*require\s+/m, "$file doesn't use require") 54 unless $file eq 'comp/require.t' 55} 56 57# There are regression tests using test.pl that don't want PL_sawampersand 58# set. Or at least that was the case until PL_sawampersand was disabled 59# and replaced with copy-on-write. 60 61# We still allow PL_sawampersand to be enabled with 62# -Accflags=-DPERL_SAWAMPERSAND, or with -DPERL_NO_COW, so its still worth 63# checking. 64# There's no portable, reliable way to check whether PL_sawampersand is 65# set, so instead we just "grep $`|$&|$' test.pl" 66 67{ 68 my $file = ''; 69 my $fh; 70 if (ok(open(my $fh, '<', 'test.pl'), "opened test.pl")) { 71 $file = do { local $/; <$fh> }; 72 $file //= ''; 73 } 74 else { 75 diag("error: $!"); 76 } 77 ok(length($file) > 0, "read test.pl successfully"); 78 ok($file !~ /\$&/, 'Nothing in test.pl mentioned $&'); 79 ok($file !~ /\$`/, 'Nothing in test.pl mentioned $`'); 80 ok($file !~ /\$'/, 'Nothing in test.pl mentioned $\''); 81} 82