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