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